File Coverage

blib/lib/WWW/Noss/Curl.pm

Criterion	Covered	Total	%
statement	14	100	14.0
branch	0	44	0.0
condition	0	30	0.0
subroutine	5	9	55.5
pod	4	4	100.0
total	23	187	12.3

package WWW::Noss::Curl;
use 5.016;
use strict;
use warnings;
our $VERSION = '2.02';

use Exporter qw(import);
our @EXPORT_OK = qw(curl curl_error http_status_string parse_http_header);

use File::Temp qw(tempfile);

# https://curl.se/docs/manpage.html
our %CODES = (
    -1 => 'Failed to execute curl',
    0  => 'Success',
    1  => 'Unsupported protocol',
    2  => 'Failed to initialize curl',
    3  => 'Malformed URL',
    4  => 'Required feature disabled',
    5  => 'Could not resolve proxy',
    6  => 'Could not resolve host',
    7  => 'Failed to connect to host',
    8  => 'Weird server reply',
    9  => 'FTP access denied',
    10 => 'FTP accept failed',
    11 => 'Weird FTP PASS reply',
    12 => 'FTP session timeout expired',
    13 => 'Weird FTP PASV reply',
    14 => 'Weird FTP 227 reply',
    15 => 'Cannot use FTP host',
    16 => 'HTTP/2 error',
    17 => 'Failed to set FTP transfer to binary',
    18 => 'Could only receive partial file',
    19 => 'FTP file access error',
    21 => 'FTP quote error',
    22 => 'HTTP page not retrieved',
    23 => 'Write error',
    25 => 'FTP STOR error',
    26 => 'Read error',
    27 => 'Out of memory',
    28 => 'Operation timeout',
    30 => 'FTP PORT failed',
    31 => 'FTP REST failed',
    33 => 'HTTP range error',
    34 => 'HTTP post error',
    35 => 'SSL connection failed',
    36 => 'Failed to resume download',
    37 => 'Failed to open file',
    38 => 'LDAP bind failed',
    39 => 'LDAP search failed',
    41 => 'LDAP function not found',
    42 => 'Aborted',
    43 => 'Internal error',
    45 => 'Interface error',
    47 => 'Too many redirects',
    48 => 'Unknown option passed to libcurl',
    49 => 'Mailformed telnet option',
    52 => 'No server reply',
    53 => 'SSL crypto engine not found',
    54 => 'Cannot set SSL crypto engine as default',
    55 => 'Failed sending network data',
    56 => 'Failed to receive network data',
    58 => 'Problem with local certificate',
    59 => 'Could not use specified SSL cipher',
    60 => 'Peer certificate cannot be authenticated with known CA certificates',
    61 => 'Unrecognized transfer encoding',
    63 => 'Maximum file size exceeded',
    64 => 'Requested FTP SSL level failed',
    65 => 'Rewind failed',
    66 => 'Failed to initialize SSL engine',
    67 => 'Username or password not accepted',
    68 => 'TFTP file not found',
    69 => 'TFTP permission error',
    70 => 'TFTP out of disk space',
    71 => 'Illegal TFTP operation',
    72 => 'Unknown TFTP transfer ID',
    73 => 'TFTP file already exists',
    74 => 'TFTP no such user',
    77 => 'Problem reading SSL CA cert',
    78 => 'Resource referenced in URL does not exist',
    79 => 'Unspecified error occurred during SSH session',
    80 => 'Failed to shut down SSL connection',
    82 => 'Could not load CRL file',
    83 => 'Issuer check failed',
    84 => 'FTP PRET failed',
    85 => 'RTSP CSeq number mismatch',
    86 => 'RTSP Session ID mismatch',
    87 => 'Failed to parse FTP file list',
    88 => 'FTP chunk callback error',
    89 => 'No connection available',
    90 => 'SSL public key does not match pinned public key',
    91 => 'Invalid SSL certificate status',
    92 => 'Stream error in HTTP/2 framing layer',
    93 => 'API function called from inside callback',
    94 => 'Authentication function returned error',
    95 => 'Error detected in HTTP/3 layer',
    96 => 'QUIC connection error',
    97 => 'Proxy handshake error',
    98 => 'Client-side certificate required to complete TLS handshake',
    99 => 'Poll or select returned fatal error',
    100 => 'Value or data field grew larger than allowed',
    # and maybe some more in the future...
);

# https://developer.mozilla.org/en-US/docs/Web/HTTP/Reference/Status
our %HTTP_CODES = (

    100 => 'Continue',
    101 => 'Switching Protocols',
    102 => 'Processing',
    103 => 'Early Hints',

    200 => 'OK',
    201 => 'Created',
    202 => 'Accepted',
    203 => 'Non-Authoritative Information',
    204 => 'No Content',
    205 => 'Reset Content',
    206 => 'Partial Content',
    207 => 'Multi-Status',
    208 => 'Already Reported',
    209 => 'IM Used',

    300 => 'Multiple Choices',
    301 => 'Moved Permanently',
    302 => 'Found',
    303 => 'See Other',
    304 => 'Not Modified',
    305 => 'Use Proxy',
    306 => 'unused',
    307 => 'Temporary Redirect',
    308 => 'Permanent Redirect',

    400 => 'Bad Request',
    401 => 'Unauthorized',
    402 => 'Payment Required',
    403 => 'Forbidden',
    404 => 'Not Found',
    405 => 'Method Not Allowed',
    406 => 'Not Acceptable',
    407 => 'Proxy Authentication Required',
    408 => 'Request Timeout',
    409 => 'Conflict',
    410 => 'Gone',
    411 => 'Length Required',
    412 => 'Precondition Failed',
    413 => 'Content Too Large',
    414 => 'URI Too Long',
    415 => 'Unsupported Media Type',
    416 => 'Range Not Satisfiable',
    417 => 'Exception Failed',
    418 => q{I'm a teapot},
    421 => 'Misdirected Request',
    422 => 'Unprocessable Content',
    423 => 'Locked',
    424 => 'Failed Dependency',
    425 => 'Too Early',
    426 => 'Upgrade Required',
    428 => 'Precondition Required',
    429 => 'Too Many Requests',
    431 => 'Request Header Fields Too Large',
    451 => 'Unavailable For Legal Reasons',

    500 => 'Internal Server Error',
    501 => 'Not Implemented',
    502 => 'Bad Gateway',
    503 => 'Service Unavailable',
    504 => 'Gateway Timeout',
    505 => 'HTTP Version Not Supported',
    506 => 'Variant Also Negotiates',
    507 => 'Insufficient Storage',
    508 => 'Loop Detected',
    510 => 'Not Extended',
    511 => 'Network Authentication Required',

);

sub curl_error {

    my ($code) = @_;

    return $CODES{ $code } // 'Unknown error';

}

sub curl {

    my ($link, $output, %param) = @_;
    my $verbose      = $param{ verbose      } // 0;
    my $agent        = $param{ agent        } // undef;
    my $time_cond    = $param{ time_cond    } // undef;
    my $remote_time  = $param{ remote_time  } // 0;
    my $etag_save    = $param{ etag_save    } // undef;
    my $etag_compare = $param{ etag_compare } // undef;
    my $limit_rate   = $param{ limit_rate   } // undef;
    my $user_agent   = $param{ user_agent   } // undef;
    my $timeout      = $param{ timeout      } // undef;
    my $fail         = $param{ fail         } // 0;
    my $proxy        = $param{ proxy        } // undef;
    my $proxy_user   = $param{ proxy_user   } // undef;
    my $redirect     = $param{ redirect     } // 0;
    my $compressed   = $param{ compressed   } // 0;

    my $tmp = do {
        my ($h, $p) = tempfile(UNLINK => 1);
        close $h;
        $p;
    };

    my @cmd = ('curl', '-D', $tmp, '-o', $output);

    if (!$verbose) {
        push @cmd, '-s';
    }

    if (defined $agent) {
        push @cmd, '-A', $agent;
    }

    if (defined $time_cond) {
        push @cmd, '-z', $time_cond;
    }

    if ($remote_time) {
        push @cmd, '-R';
    }

    if (defined $etag_save) {
        push @cmd, '--etag-save', $etag_save;
    }

    if (defined $etag_compare) {
        push @cmd, '--etag-compare', $etag_compare;
    }

    if (defined $limit_rate) {
        push @cmd, '--limit-rate', $limit_rate;
    }

    if (defined $user_agent) {
        push @cmd, '-A', $user_agent;
    }

    if (defined $timeout) {
        push @cmd, '-m', $timeout;
    }

    if ($fail) {
        push @cmd, '-f';
    }

    if (defined $proxy) {
        push @cmd, '-x', $proxy;
    }

    if (defined $proxy_user) {
        push @cmd, '-U', $proxy_user;
    }

    if (defined $redirect) {
        push @cmd, '-L';
    }

    if ($compressed) {
        push @cmd, '--compressed';
    }

    push @cmd, $link;

    system @cmd;

    my $exit = $? == -1 ? $? : $? >> 8;
    my ($resp, $head) = (
        -s $tmp
        # If there are multiple headers, only parse the last one.
        ? do {
            open my $fh, '<', $tmp or die "Failed to open $tmp for reading: $!\n";
            binmode $fh;
            my $slurp = do { local $/; <$fh> };
            close $fh;
            $slurp =~ s/(?:\r\n)*$//;
            my $headstr = (split /(?:\r\n){2,}/, $slurp)[-1];
            parse_http_header($headstr);
        }
        : (undef, {})
    );

    return ($exit, $resp, $head);

}

sub parse_http_header {

    my ($header) = @_;

    my ($resp, @lines) = split /\r\n/, $header;

    $resp =~ s/\r\n$//;
    my @resp_parts = split /\s+/, $resp, 3;
    if (@resp_parts == 2) {
        $resp_parts[2] = '';
    } elsif (@resp_parts != 3) {
        die "invalid HTTP response header";
    }

    my %head;
    for my $l (@lines) {
        $l =~ s/\r\n$//;
        if ($l eq '') {
            last;
        }
        my ($k, $v) = split /:/, $l, 2;
        if (not defined $v) {
            die "invalid HTTP response header";
        }
        $v =~ s/^\s+|\s+$//g;
        $head{ lc $k } = $v;
    }

    return (\@resp_parts, \%head);

}

sub http_status_string {

    my ($status) = @_;

    if (not exists $HTTP_CODES{ $status }) {
        die "'$status' is not a valid HTTP status code";
    }

    return $HTTP_CODES{ $status };

}

1;

=head1 NAME

WWW::Noss::Curl - Interface to curl command

=head1 USAGE

  use WWW::Noss::Curl qw(curl);

  curl('https://url', 'output');

=head1 DESCRIPTION

B is a module that provides an interface to the L
command for fetching network resources. This is a private module, please
consult the L manual for user documentation.

=head1 SUBROUTINES

Subroutines are not automatically exported.

=over 4

=item ($rt, \@resp, \%head) = curl($link, $output, [ %param ])

L C<$link> and download it to C<$output>. C<%param> is an optional
hash argument of additional parameters to pass.

Returns the exit code of L. A return value of C<0> means
success, non-zero means failure. C can be used to describe
the return value. Also returns the return values of C on
the reponse's header.

The following are valid fields for the C<%param> hash:

=over 4

=item verbose

Boolean determining whether to enable verbose output or not. Corresponds to
L's C<--silent> option. Defaults to false.

=item agent

String to use as user agent. Corresponds to L's C<--user-agent> option.
Defaults to none.

=item time_cond

Only download a file if it has been modified past the given time. Can either
be a timestamp or file. Corresponds to L's C<--time-cond> option.
Defaults to none.

=item remote_time

Copy the remote file's modification time when downloading a file. Corresponds
to L's C<--remote-time> option. Defaults to false.

=item etag_save

Path to file to write remote file's etag to, if it has one. Corresponds to
L's C<--etag-save> option. Defaults to none.

=item etag_compare

Path to file to compare remote file's etag to, only downloading the remote file
if the etags differ. Corresponds to L's C<--etag-compare> option.
Defaults to none.

=item limit_rate

Download rate to limit L to. Corresponds to L's
C<--limit-rate> option. Defaults to none.

=item user_agent

User agent string to send to server. Corresponds to L's
C<--user-agent> option. Defaults to none.

=item timeout

Maximum time in seconds a transfer is allowed to take. Corresponds to
L's C<--max-time> option. Defaults to no timeout.

=item fail

Boolean determining if L should fail with no output on server errors.
Corresponds to L's C<--fail> option. Defaults to false.

=item proxy

Host to use as proxy. Corresponds to L's C<--proxy> option. Defaults
to none.

=item proxy_user

Username and password to use for proxy, separated by a colon (C).
Corresponds to L's C<--proxy-user> option. Defaults to none.

=item redirect

Boolean determining whether to following redirections. Corresponds to
L's C<--location> option. Defaults to false.

=item compressed

Boolean determining whether to request compressed content and automatically
decompress it. Corresponds to L's C<--compressed> option. Defaults to
false.

=back

=item $desc = curl_error($rt)

Returns the string description of the C exit code C<$rt>.

=item (\@response, \%head) = parse_http_header($header)

Parses the HTTP header in C<$header>. C<\@response> is an array ref containing
the reponses's information. The first element is the protocol information, the
second is the HTTP status code, and the third is a string providing extra
information about the reponse. C<\%head> is a hash of data provided by the
response's header fields.

=item $desc = http_status_string($code)

Returns the string description of the HTTP status code C<$code>. Dies if
C<$code> is not a valid status code.

=back

=head1 GLOBAL VARIABLES

=over 4

=item %WWW::Noss::Curl::CODES

Hash of C exit codes and their corresponding string descriptions.
Use of the C function is preferable.

=back

=head1 AUTHOR

Written by Samuel Young, [e-mail].

This project's source can be found on its
L. Comments and pull
requests are welcome!

=head1 COPYRIGHT

Copyright (C) 2025-2026 Samuel Young

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

=head1 SEE ALSO

L, L

=cut

# vim: expandtab shiftwidth=4