diff --git a/perl/Curl_easy/Changes b/perl/Curl_easy/Changes index 11ac7f107..af3d9cb40 100644 --- a/perl/Curl_easy/Changes +++ b/perl/Curl_easy/Changes @@ -1,6 +1,14 @@ Revision history for Perl extension Curl::easy. Check out the file README for more info. +1.1.8 Thu Sep 20 2001: - Cris Bailiff + - Re-generate CURLOPT_ constants from curl.h and enhance makefile + to allow this to be repeated in future or for older versions of + libcurl. Constants up-to-date for libcurl-7.9(pre) + - Split tests into t/*.t to simplify each case + - Add test cases for new SSL switches. This needs ca-bundle.crt + (from mod_ssl) for verifying test cases. + 1.1.7 Thu Sep 13 2001: - Cris Bailiff - Documentation Update only - Explicitly state that Curl_easy is released under the MIT-X/MPL dual licence. No code changes. diff --git a/perl/Curl_easy/MANIFEST b/perl/Curl_easy/MANIFEST index d60043d7a..82f8c20ce 100644 --- a/perl/Curl_easy/MANIFEST +++ b/perl/Curl_easy/MANIFEST @@ -4,4 +4,13 @@ Makefile.PL README easy.pm easy.xs -test.pl +curlopt-constants.c +t/00constants.t +t/01basic.t +t/02header-callback.t +t/03body-callback.t +t/04abort-test.t +t/05progress.t +t/06http-post.t +t/07ftp-upload.t +t/08ssl.t diff --git a/perl/Curl_easy/Makefile.PL b/perl/Curl_easy/Makefile.PL index 58a8528ad..551808fa9 100644 --- a/perl/Curl_easy/Makefile.PL +++ b/perl/Curl_easy/Makefile.PL @@ -12,3 +12,76 @@ WriteMakefile( 'INC' => '', # e.g., '-I/usr/include/other' 'clean' => {FILES => "head.out body.out"} ); + +# +# This utility helper generates the constants function from curl.h +# +# It is normally only used by the maintainer, but if you're curl is older +# or missing some constants, you can delete curlopt-constants.c and re-run 'perl Makefile.PL' +# + +if (!open(CONSTANTS,") { + if ($_ =~ m/CINIT\(/ and $_ !~ m/#/) { + my ($option,$type,$code)=m/.*CINIT\((\w*)\s*,\s*(\w+)\s*,\s*(\d+).*/; + $types{$option}=$type; + $codes{$option}=$code; + } +} +close(CURL_H); + +# some things are ifdefed out... +foreach my $ifdef0 (qw(FLAGS PROGRESSMODE)) +{ + delete $types{$ifdef0}; delete $codes{$ifdef0}; +} + +open(CURL_XS,">curlopt-constants.c") or die "Can't write curlopt-constants.c\n"; +foreach my $next_initial ('A'..'Z') { + print CURL_XS " case '$next_initial':\n"; + my $count=0; + foreach my $option (sort keys %types) { + my $initial=substr($option,0,1); + if ($next_initial eq $initial) { + print CURL_XS " if (strEQ(name, \"$option\")) return CURLOPT_$option;\n"; + $count++; + } + } + if ($count) { + print CURL_XS " break;\n"; + } +} +close(CURL_XS); +} diff --git a/perl/Curl_easy/Makefile.am b/perl/Curl_easy/Makefile.am index 11724d84f..219bfa5e3 100644 --- a/perl/Curl_easy/Makefile.am +++ b/perl/Curl_easy/Makefile.am @@ -1 +1,3 @@ -EXTRA_DIST = Changes easy.pm easy.xs Makefile.PL MANIFEST README test.pl +SUBDIRS = t + +EXTRA_DIST = Changes easy.pm easy.xs curlopt-constants.c Makefile.PL MANIFEST README diff --git a/perl/Curl_easy/README b/perl/Curl_easy/README index 10ee55722..88a741923 100644 --- a/perl/Curl_easy/README +++ b/perl/Curl_easy/README @@ -11,19 +11,27 @@ installed. You then may install this module via the usual way: make test make install +If you have an older version of libcurl, you can remove 'curlopt-constants.c' +and have it rebuilt by 'perl Makefile.PL'. + +You can also do this for a later version of libcurl, except currently +you will have to update the module EXPORTS list manually. + The module provides the same functionality as libcurl provides to C programs, please refer to the documentation of libcurl. Some examples may be found in -test.pl. +t/*.t. This software is distributed AS IS, WITHOUT WARRANTY OF ANY KIND, either express or implied. Send praise, patches, money, beer and pizza to the author. Send complaints to /dev/null. ;-) -The author of this software is Georg Horn -Parts of the callback support have been added by Cris Bailiff - and Forrest Cahoon +The original author of this software is Georg Horn +Parts of the callback support, tests and documentation have been added by +Cris Bailiff and Forrest Cahoon -The latest version can be downloaded from http://koblenz-net.de/~horn/export/ +The current maintainer is Cris Bailiff + +The latest version can be downloaded from http://curl.haxx.se/libcurl/perl/ Copyright (C) 2000, Daniel Stenberg, , et al. You may opt to use, copy, modify, merge, publish, distribute and/or sell diff --git a/perl/Curl_easy/curlopt-constants.c b/perl/Curl_easy/curlopt-constants.c new file mode 100644 index 000000000..4a317deab --- /dev/null +++ b/perl/Curl_easy/curlopt-constants.c @@ -0,0 +1,125 @@ + case 'A': + if (strEQ(name, "AUTOREFERER")) return CURLOPT_AUTOREFERER; + break; + case 'B': + case 'C': + if (strEQ(name, "CAINFO")) return CURLOPT_CAINFO; + if (strEQ(name, "CLOSEFUNCTION")) return CURLOPT_CLOSEFUNCTION; + if (strEQ(name, "CLOSEPOLICY")) return CURLOPT_CLOSEPOLICY; + if (strEQ(name, "CONNECTTIMEOUT")) return CURLOPT_CONNECTTIMEOUT; + if (strEQ(name, "COOKIE")) return CURLOPT_COOKIE; + if (strEQ(name, "COOKIEFILE")) return CURLOPT_COOKIEFILE; + if (strEQ(name, "COOKIEJAR")) return CURLOPT_COOKIEJAR; + if (strEQ(name, "CRLF")) return CURLOPT_CRLF; + if (strEQ(name, "CUSTOMREQUEST")) return CURLOPT_CUSTOMREQUEST; + break; + case 'D': + case 'E': + if (strEQ(name, "EGDSOCKET")) return CURLOPT_EGDSOCKET; + if (strEQ(name, "ERRORBUFFER")) return CURLOPT_ERRORBUFFER; + break; + case 'F': + if (strEQ(name, "FAILONERROR")) return CURLOPT_FAILONERROR; + if (strEQ(name, "FILE")) return CURLOPT_FILE; + if (strEQ(name, "FILETIME")) return CURLOPT_FILETIME; + if (strEQ(name, "FOLLOWLOCATION")) return CURLOPT_FOLLOWLOCATION; + if (strEQ(name, "FORBID_REUSE")) return CURLOPT_FORBID_REUSE; + if (strEQ(name, "FRESH_CONNECT")) return CURLOPT_FRESH_CONNECT; + if (strEQ(name, "FTPAPPEND")) return CURLOPT_FTPAPPEND; + if (strEQ(name, "FTPASCII")) return CURLOPT_FTPASCII; + if (strEQ(name, "FTPLISTONLY")) return CURLOPT_FTPLISTONLY; + if (strEQ(name, "FTPPORT")) return CURLOPT_FTPPORT; + break; + case 'G': + case 'H': + if (strEQ(name, "HEADER")) return CURLOPT_HEADER; + if (strEQ(name, "HEADERFUNCTION")) return CURLOPT_HEADERFUNCTION; + if (strEQ(name, "HTTPGET")) return CURLOPT_HTTPGET; + if (strEQ(name, "HTTPHEADER")) return CURLOPT_HTTPHEADER; + if (strEQ(name, "HTTPPOST")) return CURLOPT_HTTPPOST; + if (strEQ(name, "HTTPPROXYTUNNEL")) return CURLOPT_HTTPPROXYTUNNEL; + if (strEQ(name, "HTTPREQUEST")) return CURLOPT_HTTPREQUEST; + break; + case 'I': + if (strEQ(name, "INFILE")) return CURLOPT_INFILE; + if (strEQ(name, "INFILESIZE")) return CURLOPT_INFILESIZE; + if (strEQ(name, "INTERFACE")) return CURLOPT_INTERFACE; + break; + case 'J': + case 'K': + if (strEQ(name, "KRB4LEVEL")) return CURLOPT_KRB4LEVEL; + break; + case 'L': + if (strEQ(name, "LOW_SPEED_LIMIT")) return CURLOPT_LOW_SPEED_LIMIT; + if (strEQ(name, "LOW_SPEED_TIME")) return CURLOPT_LOW_SPEED_TIME; + break; + case 'M': + if (strEQ(name, "MAXCONNECTS")) return CURLOPT_MAXCONNECTS; + if (strEQ(name, "MAXREDIRS")) return CURLOPT_MAXREDIRS; + if (strEQ(name, "MUTE")) return CURLOPT_MUTE; + break; + case 'N': + if (strEQ(name, "NETRC")) return CURLOPT_NETRC; + if (strEQ(name, "NOBODY")) return CURLOPT_NOBODY; + if (strEQ(name, "NOPROGRESS")) return CURLOPT_NOPROGRESS; + if (strEQ(name, "NOTHING")) return CURLOPT_NOTHING; + break; + case 'O': + case 'P': + if (strEQ(name, "PASSWDDATA")) return CURLOPT_PASSWDDATA; + if (strEQ(name, "PASSWDFUNCTION")) return CURLOPT_PASSWDFUNCTION; + if (strEQ(name, "PORT")) return CURLOPT_PORT; + if (strEQ(name, "POST")) return CURLOPT_POST; + if (strEQ(name, "POSTFIELDS")) return CURLOPT_POSTFIELDS; + if (strEQ(name, "POSTFIELDSIZE")) return CURLOPT_POSTFIELDSIZE; + if (strEQ(name, "POSTQUOTE")) return CURLOPT_POSTQUOTE; + if (strEQ(name, "PROGRESSDATA")) return CURLOPT_PROGRESSDATA; + if (strEQ(name, "PROGRESSFUNCTION")) return CURLOPT_PROGRESSFUNCTION; + if (strEQ(name, "PROXY")) return CURLOPT_PROXY; + if (strEQ(name, "PROXYPORT")) return CURLOPT_PROXYPORT; + if (strEQ(name, "PROXYUSERPWD")) return CURLOPT_PROXYUSERPWD; + if (strEQ(name, "PUT")) return CURLOPT_PUT; + break; + case 'Q': + if (strEQ(name, "QUOTE")) return CURLOPT_QUOTE; + break; + case 'R': + if (strEQ(name, "RANDOM_FILE")) return CURLOPT_RANDOM_FILE; + if (strEQ(name, "RANGE")) return CURLOPT_RANGE; + if (strEQ(name, "READFUNCTION")) return CURLOPT_READFUNCTION; + if (strEQ(name, "REFERER")) return CURLOPT_REFERER; + if (strEQ(name, "RESUME_FROM")) return CURLOPT_RESUME_FROM; + break; + case 'S': + if (strEQ(name, "SSLCERT")) return CURLOPT_SSLCERT; + if (strEQ(name, "SSLCERTPASSWD")) return CURLOPT_SSLCERTPASSWD; + if (strEQ(name, "SSLVERSION")) return CURLOPT_SSLVERSION; + if (strEQ(name, "SSL_CIPHER_LIST")) return CURLOPT_SSL_CIPHER_LIST; + if (strEQ(name, "SSL_VERIFYHOST")) return CURLOPT_SSL_VERIFYHOST; + if (strEQ(name, "SSL_VERIFYPEER")) return CURLOPT_SSL_VERIFYPEER; + if (strEQ(name, "STDERR")) return CURLOPT_STDERR; + break; + case 'T': + if (strEQ(name, "TELNETOPTIONS")) return CURLOPT_TELNETOPTIONS; + if (strEQ(name, "TIMECONDITION")) return CURLOPT_TIMECONDITION; + if (strEQ(name, "TIMEOUT")) return CURLOPT_TIMEOUT; + if (strEQ(name, "TIMEVALUE")) return CURLOPT_TIMEVALUE; + if (strEQ(name, "TRANSFERTEXT")) return CURLOPT_TRANSFERTEXT; + break; + case 'U': + if (strEQ(name, "UPLOAD")) return CURLOPT_UPLOAD; + if (strEQ(name, "URL")) return CURLOPT_URL; + if (strEQ(name, "USERAGENT")) return CURLOPT_USERAGENT; + if (strEQ(name, "USERPWD")) return CURLOPT_USERPWD; + break; + case 'V': + if (strEQ(name, "VERBOSE")) return CURLOPT_VERBOSE; + break; + case 'W': + if (strEQ(name, "WRITEFUNCTION")) return CURLOPT_WRITEFUNCTION; + if (strEQ(name, "WRITEHEADER")) return CURLOPT_WRITEHEADER; + if (strEQ(name, "WRITEINFO")) return CURLOPT_WRITEINFO; + break; + case 'X': + case 'Y': + case 'Z': diff --git a/perl/Curl_easy/easy.pm b/perl/Curl_easy/easy.pm index 0ffe7100d..2324ace1f 100644 --- a/perl/Curl_easy/easy.pm +++ b/perl/Curl_easy/easy.pm @@ -16,20 +16,30 @@ require AutoLoader; # Do not simply export all your public functions/methods/constants. @EXPORT = qw( CURLOPT_AUTOREFERER +CURLOPT_CAINFO +CURLOPT_CLOSEFUNCTION +CURLOPT_CLOSEPOLICY +CURLOPT_CONNECTTIMEOUT CURLOPT_COOKIE CURLOPT_COOKIEFILE +CURLOPT_COOKIEJAR CURLOPT_CRLF CURLOPT_CUSTOMREQUEST +CURLOPT_EGDSOCKET CURLOPT_ERRORBUFFER CURLOPT_FAILONERROR CURLOPT_FILE +CURLOPT_FILETIME CURLOPT_FOLLOWLOCATION +CURLOPT_FORBID_REUSE +CURLOPT_FRESH_CONNECT CURLOPT_FTPAPPEND CURLOPT_FTPASCII CURLOPT_FTPLISTONLY CURLOPT_FTPPORT CURLOPT_HEADER CURLOPT_HEADERFUNCTION +CURLOPT_HTTPGET CURLOPT_HTTPHEADER CURLOPT_HTTPPOST CURLOPT_HTTPPROXYTUNNEL @@ -40,6 +50,8 @@ CURLOPT_INTERFACE CURLOPT_KRB4LEVEL CURLOPT_LOW_SPEED_LIMIT CURLOPT_LOW_SPEED_TIME +CURLOPT_MAXCONNECTS +CURLOPT_MAXREDIRS CURLOPT_MUTE CURLOPT_NETRC CURLOPT_NOBODY @@ -59,6 +71,7 @@ CURLOPT_PROXYPORT CURLOPT_PROXYUSERPWD CURLOPT_PUT CURLOPT_QUOTE +CURLOPT_RANDOM_FILE CURLOPT_RANGE CURLOPT_READFUNCTION CURLOPT_REFERER @@ -66,7 +79,11 @@ CURLOPT_RESUME_FROM CURLOPT_SSLCERT CURLOPT_SSLCERTPASSWD CURLOPT_SSLVERSION +CURLOPT_SSL_CIPHER_LIST +CURLOPT_SSL_VERIFYHOST +CURLOPT_SSL_VERIFYPEER CURLOPT_STDERR +CURLOPT_TELNETOPTIONS CURLOPT_TIMECONDITION CURLOPT_TIMEOUT CURLOPT_TIMEVALUE @@ -78,17 +95,7 @@ CURLOPT_USERPWD CURLOPT_VERBOSE CURLOPT_WRITEFUNCTION CURLOPT_WRITEHEADER -CURLOPT_MAXREDIRS -CURLOPT_FILETIME -CURLOPT_TELNETOPTIONS -CURLOPT_MAXCONNECTS -CURLOPT_CLOSEPOLICY -CURLOPT_CLOSEFUNCTION -CURLOPT_FRESH_CONNECT -CURLOPT_FORBID_REUSE -CURLOPT_RANDOM_FILE -CURLOPT_EGD_SOCKET -CURLOPT_CONNECTTIMEOUT +CURLOPT_WRITEINFO CURLINFO_EFFECTIVE_URL CURLINFO_HTTP_CODE @@ -110,7 +117,7 @@ CURLINFO_CONTENT_LENGTH_UPLOAD USE_INTERNAL_VARS ); -$VERSION = '1.1.7'; +$VERSION = '1.1.8'; $Curl::easy::headers = ""; $Curl::easy::content = ""; @@ -133,25 +140,31 @@ bootstrap Curl::easy $VERSION; __END__ # Below is the stub of documentation for your module. You better edit it! +=pod + =head1 NAME Curl::easy - Perl extension for libcurl =head1 SYNOPSIS - use Curl::easy; + use Curl::easy; - $curl = Curl::easy::init(); - $CURLcode = Curl::easy::setopt($curl, CURLoption, Value); - $CURLcode = Curl::easy::perform($curl); - Curl::easy::cleanup($curl); + $curl = Curl::easy::init(); + $CURLcode = Curl::easy::setopt($curl, CURLoption, Value); + $CURLcode = Curl::easy::perform($curl); + Curl::easy::cleanup($curl); + + Read curl_easy_setopt for details of most CURLoption values + +=head1 DESCRIPTION + + -=head1 DESCRIPTION - -This perl module provides an interface to the libcurl C library. See +B provides an interface to the libcurl C library. See http://curl.haxx.se/ for more information on cURL and libcurl. - -=head1 FILES and CALLBACKS + +=head2 FILES and CALLBACKS Curl::easy supports the various options of curl_easy_setopt which require either a FILE * or a callback function. @@ -254,9 +267,11 @@ indicate an error. Georg Horn -Additional callback,pod and test work by Cris Bailiff +Additional callback, pod and test work by Cris Bailiff and Forrest Cahoon +Currently maintained by Cris Bailiff + =head1 Copyright Copyright (C) 2000, Daniel Stenberg, , et al. diff --git a/perl/Curl_easy/easy.xs b/perl/Curl_easy/easy.xs index f7bf4f790..f43d482cd 100644 --- a/perl/Curl_easy/easy.xs +++ b/perl/Curl_easy/easy.xs @@ -437,123 +437,7 @@ constant(char *name, int arg) if (strncmp(name, "CURLOPT_", 8) == 0) { name += 8; switch (*name) { - case 'A': - case 'B': - if (strEQ(name, "AUTOREFERER")) return CURLOPT_AUTOREFERER; - break; - case 'C': - if (strEQ(name, "CONNECTTIMEOUT")) return CURLOPT_CONNECTTIMEOUT; - if (strEQ(name, "COOKIE")) return CURLOPT_COOKIE; - if (strEQ(name, "COOKIEFILE")) return CURLOPT_COOKIEFILE; - if (strEQ(name, "CLOSEFUNCTION")) return CURLOPT_CLOSEFUNCTION; - if (strEQ(name, "CLOSEPOLICY")) return CURLOPT_CLOSEPOLICY; - if (strEQ(name, "CRLF")) return CURLOPT_CRLF; - if (strEQ(name, "CUSTOMREQUEST")) return CURLOPT_CUSTOMREQUEST; - break; - case 'D': - case 'E': - if (strEQ(name, "EGDSOCKET")) return CURLOPT_EGDSOCKET; - if (strEQ(name, "ERRORBUFFER")) return CURLOPT_ERRORBUFFER; - break; - case 'F': - if (strEQ(name, "FAILONERROR")) return CURLOPT_FAILONERROR; - if (strEQ(name, "FILE")) return CURLOPT_FILE; - if (strEQ(name, "FILETIME")) return CURLOPT_FILETIME; - if (strEQ(name, "FOLLOWLOCATION")) return CURLOPT_FOLLOWLOCATION; - if (strEQ(name, "FORBID_REUSE")) return CURLOPT_FORBID_REUSE; - if (strEQ(name, "FTPAPPEND")) return CURLOPT_FTPAPPEND; - if (strEQ(name, "FTPASCII")) return CURLOPT_FTPASCII; - if (strEQ(name, "FTPLISTONLY")) return CURLOPT_FTPLISTONLY; - if (strEQ(name, "FTPPORT")) return CURLOPT_FTPPORT; - if (strEQ(name, "FRESH_CONNECT")) return CURLOPT_FRESH_CONNECT; - break; - case 'G': - case 'H': - if (strEQ(name, "HEADER")) return CURLOPT_HEADER; - if (strEQ(name, "HEADERFUNCTION")) return CURLOPT_HEADERFUNCTION; - if (strEQ(name, "HTTPHEADER")) return CURLOPT_HTTPHEADER; - if (strEQ(name, "HTTPPOST")) return CURLOPT_HTTPPOST; - if (strEQ(name, "HTTPPROXYTUNNEL")) return CURLOPT_HTTPPROXYTUNNEL; - if (strEQ(name, "HTTPREQUEST")) return CURLOPT_HTTPREQUEST; - break; - case 'I': - case 'J': - if (strEQ(name, "INFILE")) return CURLOPT_INFILE; - if (strEQ(name, "INFILESIZE")) return CURLOPT_INFILESIZE; - if (strEQ(name, "INTERFACE")) return CURLOPT_INTERFACE; - break; - case 'K': - case 'L': - if (strEQ(name, "KRB4LEVEL")) return CURLOPT_KRB4LEVEL; - if (strEQ(name, "LOW_SPEED_LIMIT")) return CURLOPT_LOW_SPEED_LIMIT; - if (strEQ(name, "LOW_SPEED_TIME")) return CURLOPT_LOW_SPEED_TIME; - break; - case 'M': - if (strEQ(name, "MAXCONNECTS")) return CURLOPT_MAXCONNECTS; - if (strEQ(name, "MAXREDIRS")) return CURLOPT_MAXREDIRS; - break; - case 'N': - if (strEQ(name, "MUTE")) return CURLOPT_MUTE; - if (strEQ(name, "NETRC")) return CURLOPT_NETRC; - if (strEQ(name, "NOBODY")) return CURLOPT_NOBODY; - if (strEQ(name, "NOPROGRESS")) return CURLOPT_NOPROGRESS; - if (strEQ(name, "NOTHING")) return CURLOPT_NOTHING; - break; - case 'O': - case 'P': - if (strEQ(name, "PASSWDDATA")) return CURLOPT_PASSWDDATA; - if (strEQ(name, "PASSWDFUNCTION")) return CURLOPT_PASSWDFUNCTION; - if (strEQ(name, "PORT")) return CURLOPT_PORT; - if (strEQ(name, "POST")) return CURLOPT_POST; - if (strEQ(name, "POSTFIELDS")) return CURLOPT_POSTFIELDS; - if (strEQ(name, "POSTFIELDSIZE")) return CURLOPT_POSTFIELDSIZE; - if (strEQ(name, "POSTQUOTE")) return CURLOPT_POSTQUOTE; - if (strEQ(name, "PROGRESSDATA")) return CURLOPT_PROGRESSDATA; - if (strEQ(name, "PROGRESSFUNCTION")) return CURLOPT_PROGRESSFUNCTION; - if (strEQ(name, "PROXY")) return CURLOPT_PROXY; - if (strEQ(name, "PROXYPORT")) return CURLOPT_PROXYPORT; - if (strEQ(name, "PROXYUSERPWD")) return CURLOPT_PROXYUSERPWD; - if (strEQ(name, "PUT")) return CURLOPT_PUT; - break; - case 'Q': - if (strEQ(name, "QUOTE")) return CURLOPT_QUOTE; - break; - case 'R': - if (strEQ(name, "RANDOM_FILE")) return CURLOPT_RANDOM_FILE; - if (strEQ(name, "RANGE")) return CURLOPT_RANGE; - if (strEQ(name, "READFUNCTION")) return CURLOPT_READFUNCTION; - if (strEQ(name, "REFERER")) return CURLOPT_REFERER; - if (strEQ(name, "RESUME_FROM")) return CURLOPT_RESUME_FROM; - break; - case 'S': - if (strEQ(name, "SSLCERT")) return CURLOPT_SSLCERT; - if (strEQ(name, "SSLCERTPASSWD")) return CURLOPT_SSLCERTPASSWD; - if (strEQ(name, "SSLVERSION")) return CURLOPT_SSLVERSION; - if (strEQ(name, "STDERR")) return CURLOPT_STDERR; - break; - case 'T': - if (strEQ(name, "TELNETOPTIONS")) return CURLOPT_TELNETOPTIONS; - if (strEQ(name, "TIMECONDITION")) return CURLOPT_TIMECONDITION; - if (strEQ(name, "TIMEOUT")) return CURLOPT_TIMEOUT; - if (strEQ(name, "TIMEVALUE")) return CURLOPT_TIMEVALUE; - if (strEQ(name, "TRANSFERTEXT")) return CURLOPT_TRANSFERTEXT; - break; - case 'U': - case 'V': - if (strEQ(name, "UPLOAD")) return CURLOPT_UPLOAD; - if (strEQ(name, "URL")) return CURLOPT_URL; - if (strEQ(name, "USERAGENT")) return CURLOPT_USERAGENT; - if (strEQ(name, "USERPWD")) return CURLOPT_USERPWD; - if (strEQ(name, "VERBOSE")) return CURLOPT_VERBOSE; - break; - case 'W': - case 'X': - case 'Y': - case 'Z': - if (strEQ(name, "WRITEFUNCTION")) return CURLOPT_WRITEFUNCTION; - if (strEQ(name, "WRITEHEADER")) return CURLOPT_WRITEHEADER; - if (strEQ(name, "WRITEINFO")) return CURLOPT_WRITEINFO; - break; +#include "curlopt-constants.c" } } if (strEQ(name, "USE_INTERNAL_VARS")) return USE_INTERNAL_VARS; diff --git a/perl/Curl_easy/t/00constants.t b/perl/Curl_easy/t/00constants.t new file mode 100644 index 000000000..2ef15453e --- /dev/null +++ b/perl/Curl_easy/t/00constants.t @@ -0,0 +1,38 @@ + +# Test script for Perl extension Curl::easy. +# Check out the file README for more info. + +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl thisfile.t' + +######################### We start with some black magic to print on failure. + +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) +use Benchmark; +use strict; + +BEGIN { $| = 1; print "1..2\n"; } +END {print "not ok 1\n" unless $::loaded;} +use Curl::easy; + +$::loaded = 1; +print "ok 1\n"; + +######################## End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +my $count=1; + +print STDERR "Testing curl version ",&Curl::easy::version(),"\n"; + +if (CURLOPT_URL != 10000+2) { + print "not "; +} + +print "ok ".++$count; + +exit; diff --git a/perl/Curl_easy/t/01basic.t b/perl/Curl_easy/t/01basic.t new file mode 100644 index 000000000..79a6e8a24 --- /dev/null +++ b/perl/Curl_easy/t/01basic.t @@ -0,0 +1,93 @@ +# Test script for Perl extension Curl::easy. +# Check out the file README for more info. + +# Before `make install' is performed this script should be runnable with +# `make t/thisfile.t'. After `make install' it should work as `perl thisfile.t' + +######################### We start with some black magic to print on failure. + +# Change 1..1 below to 1..last_test_to_print . +use strict; + +BEGIN { $| = 1; print "1..6\n"; } +END {print "not ok 1\n" unless $::loaded;} +use Curl::easy; + +$::loaded = 1; +print "ok 1\n"; + +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +my $count=1; + +# Read URL to get +my $defurl = "http://localhost/cgi-bin/printenv"; +my $url; +if (defined ($ENV{CURL_TEST_URL})) { + $url=$ENV{CURL_TEST_URL}; +} else { +$url = ""; +print "Please enter an URL to fetch [$defurl]: "; +$url = ; +if ($url =~ /^\s*\n/) { + $url = $defurl; +} +} + +# Init the curl session +my $curl = Curl::easy::init(); +if ($curl == 0) { + print "not "; +} +print "ok ".++$count."\n"; + +Curl::easy::setopt($curl, CURLOPT_NOPROGRESS, 1); +Curl::easy::setopt($curl, CURLOPT_MUTE, 1); +Curl::easy::setopt($curl, CURLOPT_FOLLOWLOCATION, 1); +Curl::easy::setopt($curl, CURLOPT_TIMEOUT, 30); + +open HEAD, ">head.out"; +Curl::easy::setopt($curl, CURLOPT_WRITEHEADER, *HEAD); +print "ok ".++$count."\n"; + +open BODY, ">body.out"; +Curl::easy::setopt($curl, CURLOPT_FILE,*BODY); +print "ok ".++$count."\n"; + +my $errbuf; +Curl::easy::setopt($curl, CURLOPT_ERRORBUFFER, "errbuf"); +print "ok ".++$count."\n"; + +Curl::easy::setopt($curl, CURLOPT_URL, $url); + +print "ok ".++$count."\n"; +# Add some additional headers to the http-request: +my @myheaders; +$myheaders[0] = "Server: www"; +$myheaders[1] = "User-Agent: Perl interface for libcURL"; +Curl::easy::setopt($curl, CURLOPT_HTTPHEADER, \@myheaders); + +my $bytes; +my $realurl; +my $httpcode; + +# Go get it +my $retcode=Curl::easy::perform($curl); +if ($retcode == 0) { + Curl::easy::getinfo($curl, CURLINFO_SIZE_DOWNLOAD, $bytes); + print STDERR "$bytes bytes read "; + Curl::easy::getinfo($curl, CURLINFO_EFFECTIVE_URL, $realurl); + Curl::easy::getinfo($curl, CURLINFO_HTTP_CODE, $httpcode); + print STDERR "effective fetched url (http code: $httpcode) was: $url "; +} else { + # We can acces the error message in $errbuf here + print STDERR "$retcode / '$errbuf'\n"; + print "not "; +} +print "ok ".++$count."\n"; + +exit; diff --git a/perl/Curl_easy/t/02header-callback.t b/perl/Curl_easy/t/02header-callback.t new file mode 100644 index 000000000..94a745c39 --- /dev/null +++ b/perl/Curl_easy/t/02header-callback.t @@ -0,0 +1,89 @@ +# Test script for Perl extension Curl::easy. +# Check out the file README for more info. + +# Before `make install' is performed this script should be runnable with +# `make t/thisfile.t'. After `make install' it should work as `perl thisfile.t' + +######################### We start with some black magic to print on failure. + +# Change 1..1 below to 1..last_test_to_print . +use strict; + +BEGIN { $| = 1; print "1..9\n"; } +END {print "not ok 1\n" unless $::loaded;} +use Curl::easy; + +$::loaded = 1; +print "ok 1\n"; + +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +my $count=1; + +# Read URL to get +my $defurl = "http://localhost/cgi-bin/printenv"; +my $url; +if (defined ($ENV{CURL_TEST_URL})) { + $url=$ENV{CURL_TEST_URL}; +} else { +$url = ""; +print "Please enter an URL to fetch [$defurl]: "; +$url = ; +if ($url =~ /^\s*\n/) { + $url = $defurl; +} +} + +# Init the curl session +my $curl = Curl::easy::init(); +if ($curl == 0) { + print "not "; +} +print "ok ".++$count."\n"; + +Curl::easy::setopt($curl, CURLOPT_NOPROGRESS, 1); +Curl::easy::setopt($curl, CURLOPT_MUTE, 1); +Curl::easy::setopt($curl, CURLOPT_FOLLOWLOCATION, 1); +Curl::easy::setopt($curl, CURLOPT_TIMEOUT, 30); + +open HEAD, ">head.out"; +Curl::easy::setopt($curl, CURLOPT_WRITEHEADER, *HEAD); +print "ok ".++$count."\n"; + +open BODY, ">body.out"; +Curl::easy::setopt($curl, CURLOPT_FILE,*BODY); +print "ok ".++$count."\n"; + +my $errbuf; +Curl::easy::setopt($curl, CURLOPT_ERRORBUFFER, "errbuf"); +print "ok ".++$count."\n"; + +Curl::easy::setopt($curl, CURLOPT_URL, $url); + +print "ok ".++$count."\n"; +# The header callback will only be called if your libcurl has the +# CURLOPT_HEADERFUNCTION supported, otherwise your headers +# go to CURLOPT_WRITEFUNCTION instead... +# + +my $header_called=0; +sub header_callback { print STDERR "header callback called\n"; $header_called=1; return length($_[0])}; + +# test for sub reference and head callback +Curl::easy::setopt($curl, CURLOPT_HEADERFUNCTION, \&header_callback); +print "ok ".++$count."\n"; + +if (Curl::easy::perform($curl) != 0) { + print "not "; +}; +print "ok ".++$count."\n"; + +print STDERR "next test will fail on libcurl < 7.7.2\n"; +print "not " if (!$header_called); # ok if you have a libcurl <7.7.2 +print "ok ".++$count."\n"; + +exit; diff --git a/perl/Curl_easy/t/03body-callback.t b/perl/Curl_easy/t/03body-callback.t new file mode 100644 index 000000000..94786f507 --- /dev/null +++ b/perl/Curl_easy/t/03body-callback.t @@ -0,0 +1,105 @@ +# Test script for Perl extension Curl::easy. +# Check out the file README for more info. + +# Before `make install' is performed this script should be runnable with +# `make t/thisfile.t'. After `make install' it should work as `perl thisfile.t' + +######################### We start with some black magic to print on failure. + +# Change 1..1 below to 1..last_test_to_print . +use strict; + +BEGIN { $| = 1; print "1..9\n"; } +END {print "not ok 1\n" unless $::loaded;} +use Curl::easy; + +$::loaded = 1; +print "ok 1\n"; + +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +my $count=1; + +# Read URL to get +my $defurl = "http://localhost/cgi-bin/printenv"; +my $url; +if (defined ($ENV{CURL_TEST_URL})) { + $url=$ENV{CURL_TEST_URL}; +} else { +$url = ""; +print "Please enter an URL to fetch [$defurl]: "; +$url = ; +if ($url =~ /^\s*\n/) { + $url = $defurl; +} +} + +# Init the curl session +my $curl = Curl::easy::init(); +if ($curl == 0) { + print "not "; +} +print "ok ".++$count."\n"; + +Curl::easy::setopt($curl, CURLOPT_NOPROGRESS, 1); +Curl::easy::setopt($curl, CURLOPT_MUTE, 1); +Curl::easy::setopt($curl, CURLOPT_FOLLOWLOCATION, 1); +Curl::easy::setopt($curl, CURLOPT_TIMEOUT, 30); + +open HEAD, ">head.out"; +Curl::easy::setopt($curl, CURLOPT_WRITEHEADER, *HEAD); +print "ok ".++$count."\n"; + +open BODY, ">body.out"; +Curl::easy::setopt($curl, CURLOPT_FILE,*BODY); +print "ok ".++$count."\n"; + +my $errbuf; +Curl::easy::setopt($curl, CURLOPT_ERRORBUFFER, "errbuf"); +print "ok ".++$count."\n"; + +Curl::easy::setopt($curl, CURLOPT_URL, $url); + +print "ok ".++$count."\n"; + +# The header callback will only be called if your libcurl has the +# CURLOPT_HEADERFUNCTION supported, otherwise your headers +# go to CURLOPT_WRITEFUNCTION instead... +# + +my $header_called=0; +sub header_callback { print STDERR "header callback called\n"; $header_called=1; return length($_[0])}; + +# test for sub reference and head callback +Curl::easy::setopt($curl, CURLOPT_HEADERFUNCTION, \&header_callback); + +my $body_called=0; +sub body_callback { + my ($chunk,$handle)=@_; + print STDERR "body callback called with ",length($chunk)," bytes\n"; + print STDERR "data=$chunk\n"; + $body_called++; + return length($chunk); # OK +} + + +# test for ref to sub and body callback +my $body_ref=\&body_callback; +Curl::easy::setopt($curl, CURLOPT_WRITEFUNCTION, $body_ref); + +if (Curl::easy::perform($curl) != 0) { + print "not "; +}; +print "ok ".++$count."\n"; + + +print STDERR "next test will fail on libcurl < 7.7.2\n"; +print STDERR "not " if (!$header_called); # ok if you have a libcurl <7.7.2 +print "ok ".++$count."\n"; + +print "not " if (!$body_called); +print "ok ".++$count."\n"; diff --git a/perl/Curl_easy/t/04abort-test.t b/perl/Curl_easy/t/04abort-test.t new file mode 100644 index 000000000..c3d71bb02 --- /dev/null +++ b/perl/Curl_easy/t/04abort-test.t @@ -0,0 +1,87 @@ +# Test script for Perl extension Curl::easy. +# Check out the file README for more info. + +# Before `make install' is performed this script should be runnable with +# `make t/thisfile.t'. After `make install' it should work as `perl thisfile.t' + +######################### We start with some black magic to print on failure. + +# Change 1..1 below to 1..last_test_to_print . +use strict; + +BEGIN { $| = 1; print "1..8\n"; } +END {print "not ok 1\n" unless $::loaded;} +use Curl::easy; + +$::loaded = 1; +print "ok 1\n"; + +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +my $count=1; + +# Read URL to get +my $defurl = "http://localhost/cgi-bin/printenv"; +my $url; +if (defined ($ENV{CURL_TEST_URL})) { + $url=$ENV{CURL_TEST_URL}; +} else { +$url = ""; +print "Please enter an URL to fetch [$defurl]: "; +$url = ; +if ($url =~ /^\s*\n/) { + $url = $defurl; +} +} + +# Init the curl session +my $curl = Curl::easy::init(); +if ($curl == 0) { + print "not "; +} +print "ok ".++$count."\n"; + +Curl::easy::setopt($curl, CURLOPT_NOPROGRESS, 1); +Curl::easy::setopt($curl, CURLOPT_MUTE, 1); +Curl::easy::setopt($curl, CURLOPT_FOLLOWLOCATION, 1); +Curl::easy::setopt($curl, CURLOPT_TIMEOUT, 30); + +open HEAD, ">head.out"; +Curl::easy::setopt($curl, CURLOPT_WRITEHEADER, *HEAD); +print "ok ".++$count."\n"; + +open BODY, ">body.out"; +Curl::easy::setopt($curl, CURLOPT_FILE,*BODY); +print "ok ".++$count."\n"; + +my $errbuf; +Curl::easy::setopt($curl, CURLOPT_ERRORBUFFER, "errbuf"); +print "ok ".++$count."\n"; + +Curl::easy::setopt($curl, CURLOPT_URL, $url); + +print "ok ".++$count."\n"; + +my $body_abort_called=0; +sub body_abort_callback { + my ($chunk,$sv)=@_; + print STDERR "body abort callback called with ",length($chunk)," bytes\n"; + $body_abort_called++; + return -1; # signal a failure +} + +# test we can abort a request mid-way +my $body_abort_ref=\&body_abort_callback; +Curl::easy::setopt($curl, CURLOPT_WRITEFUNCTION, $body_abort_ref); + +if (Curl::easy::perform($curl) == 0) { # reverse test - this should have failed + print "not "; +}; +print "ok ".++$count."\n"; + +print "not " if (!$body_abort_called); # should have been called +print "ok ".++$count."\n"; diff --git a/perl/Curl_easy/t/05progress.t b/perl/Curl_easy/t/05progress.t new file mode 100644 index 000000000..ffcdb8036 --- /dev/null +++ b/perl/Curl_easy/t/05progress.t @@ -0,0 +1,99 @@ +# Test script for Perl extension Curl::easy. +# Check out the file README for more info. + +# Before `make install' is performed this script should be runnable with +# `make t/thisfile.t'. After `make install' it should work as `perl thisfile.t' + +######################### We start with some black magic to print on failure. + +# Change 1..1 below to 1..last_test_to_print . +use strict; + +BEGIN { $| = 1; print "1..9\n"; } +END {print "not ok 1\n" unless $::loaded;} +use Curl::easy; + +$::loaded = 1; +print "ok 1\n"; + +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +my $count=1; + +# Read URL to get +my $defurl = "http://localhost/cgi-bin/printenv"; +my $url; +if (defined ($ENV{CURL_TEST_URL})) { + $url=$ENV{CURL_TEST_URL}; +} else { +$url = ""; +print "Please enter an URL to fetch [$defurl]: "; +$url = ; +if ($url =~ /^\s*\n/) { + $url = $defurl; +} +} + +# Init the curl session +my $curl = Curl::easy::init(); +if ($curl == 0) { + print "not "; +} +print "ok ".++$count."\n"; + +Curl::easy::setopt($curl, CURLOPT_NOPROGRESS, 1); +Curl::easy::setopt($curl, CURLOPT_MUTE, 1); +Curl::easy::setopt($curl, CURLOPT_FOLLOWLOCATION, 1); +Curl::easy::setopt($curl, CURLOPT_TIMEOUT, 30); + +open HEAD, ">head.out"; +Curl::easy::setopt($curl, CURLOPT_WRITEHEADER, *HEAD); +print "ok ".++$count."\n"; + +open BODY, ">body.out"; +Curl::easy::setopt($curl, CURLOPT_FILE,*BODY); +print "ok ".++$count."\n"; + +my $errbuf; +Curl::easy::setopt($curl, CURLOPT_ERRORBUFFER, "errbuf"); +print "ok ".++$count."\n"; + +Curl::easy::setopt($curl, CURLOPT_URL, $url); + +print "ok ".++$count."\n"; + +Curl::easy::setopt($curl, CURLOPT_NOPROGRESS, 0); +print "ok ".++$count."\n"; + +# inline progress function +# tests for inline subs and progress callback +# - progress callback must return 'true' on each call. + +my $progress_called=0; +sub prog_callb +{ + my ($clientp,$dltotal,$dlnow,$ultotal,$ulnow)=@_; + print STDERR "\nperl progress_callback has been called!\n"; + print STDERR "clientp: $clientp, dltotal: $dltotal, dlnow: $dlnow, ultotal: $ultotal, "; + print STDERR "ulnow: $ulnow\n"; + $progress_called++; + return 0; +} + +Curl::easy::setopt($curl, CURLOPT_PROGRESSFUNCTION, \&prog_callb); + +# Turn progress meter back on - this doesn't work in older libcurls - once its off, its off. +Curl::easy::setopt($curl, CURLOPT_NOPROGRESS, 0); + +if (Curl::easy::perform($curl) != 0) { + print "not "; +}; +print "ok ".++$count."\n"; + +print "not " if (!$progress_called); +print "ok ".++$count."\n"; + diff --git a/perl/Curl_easy/t/06http-post.t b/perl/Curl_easy/t/06http-post.t new file mode 100644 index 000000000..c38cab98d --- /dev/null +++ b/perl/Curl_easy/t/06http-post.t @@ -0,0 +1,99 @@ +# Test script for Perl extension Curl::easy. +# Check out the file README for more info. + +# Before `make install' is performed this script should be runnable with +# `make t/thisfile.t'. After `make install' it should work as `perl thisfile.t' + +######################### We start with some black magic to print on failure. + +# Change 1..1 below to 1..last_test_to_print . +use strict; + +BEGIN { $| = 1; print "1..7\n"; } +END {print "not ok 1\n" unless $::loaded;} +use Curl::easy; + +$::loaded = 1; +print "ok 1\n"; + +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +my $count=1; + +# Read URL to get +my $defurl = "http://localhost/cgi-bin/printenv"; +my $url; +if (defined ($ENV{CURL_TEST_URL})) { + $url=$ENV{CURL_TEST_URL}; +} else { +$url = ""; +print "Please enter an URL to fetch [$defurl]: "; +$url = ; +if ($url =~ /^\s*\n/) { + $url = $defurl; +} +} + +# Init the curl session +my $curl = Curl::easy::init(); +if ($curl == 0) { + print "not "; +} +print "ok ".++$count."\n"; + +Curl::easy::setopt($curl, CURLOPT_NOPROGRESS, 1); +Curl::easy::setopt($curl, CURLOPT_MUTE, 1); +Curl::easy::setopt($curl, CURLOPT_FOLLOWLOCATION, 1); +Curl::easy::setopt($curl, CURLOPT_TIMEOUT, 30); + +open HEAD, ">head.out"; +Curl::easy::setopt($curl, CURLOPT_WRITEHEADER, *HEAD); +print "ok ".++$count."\n"; + +open BODY, ">body.out"; +Curl::easy::setopt($curl, CURLOPT_FILE,*BODY); +print "ok ".++$count."\n"; + +my $errbuf; +Curl::easy::setopt($curl, CURLOPT_ERRORBUFFER, "errbuf"); +print "ok ".++$count."\n"; + +Curl::easy::setopt($curl, CURLOPT_URL, $url); + +print "ok ".++$count."\n"; + +my $read_max=1000; + +sub read_callb +{ + my ($maxlen,$sv)=@_; + print STDERR "\nperl read_callback has been called!\n"; + print STDERR "max data size: $maxlen - need $read_max bytes\n"; + if ($read_max > 0) { + my $len=int($read_max/3)+1; + my $data = chr(ord('A')+rand(26))x$len; + print STDERR "generated max/3=", int($read_max/3)+1, " characters to be uploaded - $data.\n"; + $read_max=$read_max-length($data); + return $data; + } else { + return ""; + } +} + +# +# test post/read callback functions - requires a url which accepts posts, or it fails! +# + +Curl::easy::setopt($curl,CURLOPT_READFUNCTION,\&read_callb); +Curl::easy::setopt($curl,CURLOPT_INFILESIZE,$read_max ); +Curl::easy::setopt($curl,CURLOPT_UPLOAD,1 ); +Curl::easy::setopt($curl,CURLOPT_CUSTOMREQUEST,"POST" ); + +if (Curl::easy::perform($curl) != 0) { + print "not "; +}; +print "ok ".++$count."\n"; diff --git a/perl/Curl_easy/t/07ftp-upload.t b/perl/Curl_easy/t/07ftp-upload.t new file mode 100644 index 000000000..c23a180d2 --- /dev/null +++ b/perl/Curl_easy/t/07ftp-upload.t @@ -0,0 +1,129 @@ +# Test script for Perl extension Curl::easy. +# Check out the file README for more info. + +# Before `make install' is performed this script should be runnable with +# `make t/thisfile.t'. After `make install' it should work as `perl thisfile.t' + +######################### We start with some black magic to print on failure. + +# Change 1..1 below to 1..last_test_to_print . +use strict; + +BEGIN { $| = 1; print "1..10\n"; } +END {print "not ok 1\n" unless $::loaded;} +use Curl::easy; + +$::loaded = 1; +print "ok 1\n"; + +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +my $count=1; + +# Read URL to get +my $defurl = "ftp://user\@localhost//tmp/blah"; +my $url; +if (defined ($ENV{CURL_TEST_URL_FTP})) { + $url=$ENV{CURL_TEST_URL_FTP}; +};# else { +#$url = ""; +#print "Please enter an URL to fetch [$defurl]: "; +#$url = ; +#if ($url =~ /^\s*\n/) { + $url = $defurl; +#} +#} + +# Init the curl session +my $curl = Curl::easy::init(); +if ($curl == 0) { + print "not "; +} +print "ok ".++$count."\n"; + +Curl::easy::setopt($curl, CURLOPT_NOPROGRESS, 1); +Curl::easy::setopt($curl, CURLOPT_MUTE, 1); +Curl::easy::setopt($curl, CURLOPT_FOLLOWLOCATION, 1); +Curl::easy::setopt($curl, CURLOPT_TIMEOUT, 30); + +open HEAD, ">head.out"; +Curl::easy::setopt($curl, CURLOPT_WRITEHEADER, *HEAD); +print "ok ".++$count."\n"; + +open BODY, ">body.out"; +Curl::easy::setopt($curl, CURLOPT_FILE,*BODY); +print "ok ".++$count."\n"; + +my $errbuf; +Curl::easy::setopt($curl, CURLOPT_ERRORBUFFER, "errbuf"); +print "ok ".++$count."\n"; + +Curl::easy::setopt($curl, CURLOPT_URL, $url); + +print "ok ".++$count."\n"; + +sub passwd_callb +{ + my ($clientp,$prompt,$buflen)=@_; + print STDERR "\nperl passwd_callback has been called!\n"; + print STDERR "clientp: $clientp, prompt: $prompt, buflen: $buflen\n"; + print STDERR "\nEnter max $buflen characters for $prompt "; + my $data = ; + chomp($data); + return (0,$data); +} + +# Now do an ftp upload: + + +Curl::easy::setopt($curl, Curl::easy::CURLOPT_UPLOAD, 1); + + +my $read_max=1000; +Curl::easy::setopt($curl,CURLOPT_INFILESIZE,$read_max ); +print "ok ".++$count."\n"; + +sub read_callb +{ + my ($maxlen,$sv)=@_; + print STDERR "\nperl read_callback has been called!\n"; + print STDERR "max data size: $maxlen - $read_max bytes needed\n"; + + if ($read_max > 0) { + my $len=int($read_max/3)+1; + my $data = chr(ord('A')+rand(26))x$len; + print STDERR "generated max/3=", int($read_max/3)+1, " characters to be uploaded - $data.\n"; + $read_max=$read_max-length($data); + return $data; + } else { + return ""; + } +} + +# Use perl read callback to read data to be uploaded +Curl::easy::setopt($curl, Curl::easy::CURLOPT_READFUNCTION, \&read_callb); + +# Use perl passwd callback to read password for login to ftp server +Curl::easy::setopt($curl, Curl::easy::CURLOPT_PASSWDFUNCTION, \&passwd_callb); + +print "ok ".++$count."\n"; +my $bytes; + +# Go get it +if (Curl::easy::perform($curl) == 0) { + Curl::easy::getinfo($curl, Curl::easy::CURLINFO_SIZE_UPLOAD, $bytes); + print STDERR "$bytes bytes transferred\n"; +} else { + # We can acces the error message in $errbuf here + print STDERR "'$errbuf'\n"; + print "not "; +} +print "ok ".++$count."\n"; + +# Cleanup +Curl::easy::cleanup($curl); +print "ok ".++$count."\n"; diff --git a/perl/Curl_easy/t/08ssl.t b/perl/Curl_easy/t/08ssl.t new file mode 100644 index 000000000..0da9a556c --- /dev/null +++ b/perl/Curl_easy/t/08ssl.t @@ -0,0 +1,98 @@ +# Test script for Perl extension Curl::easy. +# Check out the file README for more info. + +# Before `make install' is performed this script should be runnable with +# `make t/thisfile.t'. After `make install' it should work as `perl thisfile.t' + +######################### We start with some black magic to print on failure. + +# Change 1..1 below to 1..last_test_to_print . +use strict; + +BEGIN { $| = 1; print "1..20\n"; } +END {print "not ok 1\n" unless $::loaded;} +use Curl::easy; + +$::loaded = 1; +print "ok 1\n"; + +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +my $count=1; + +# list of tests +# site-url, verifypeer(0,1), verifyhost(0,2), result(0=ok, 1=fail) +my $url_list=[ + [ 'https://216.168.252.86/', 0, 0, 0 ], # www.awayweb.com + [ 'https://216.168.252.86/', 0, 2, 1 ], # www.awayweb.com + [ 'https://www.verisign.com/', 0, 0, 0 ], + [ 'https://www.verisign.com/', 0, 2, 0 ], + [ 'https://www.verisign.com/', 1, 2, 0 ], # these fail on openssl0.9.5 - unknown sig + [ 'https://www.verisign.com/', 1, 2, 0 ], # these fail on openssl0.9.5 - unknown sig + [ 'https://lc2.law13.hotmail.passport.com/', 0, 0, 0 ], + [ 'https://lc2.law13.hotmail.passport.com/', 0, 2, 0 ], + [ 'https://lc2.law13.hotmail.passport.com/', 1, 2, 0 ], # fail on 0.9.5 + [ 'https://lc2.law13.hotmail.passport.com/', 1, 2, 0 ], # fail on 0.9.5 + [ 'https://www.modssl.org/', 0, 0, 0 ], + [ 'https://www.modssl.org/', 0, 2, 0 ], + [ 'https://www.modssl.org/', 1, 0, 1 ], + [ 'https://www.modssl.org/', 1, 2, 1 ], +]; + +# Init the curl session +my $curl = Curl::easy::init(); +if ($curl == 0) { + print "not "; +} +print "ok ".++$count."\n"; + + +Curl::easy::setopt($curl, CURLOPT_NOPROGRESS, 1); +Curl::easy::setopt($curl, CURLOPT_MUTE, 0); +#Curl::easy::setopt($curl, CURLOPT_FOLLOWLOCATION, 1); +Curl::easy::setopt($curl, CURLOPT_TIMEOUT, 30); + +my @myheaders; +$myheaders[1] = "User-Agent: Verifying SSL functions in perl interface for libcURL"; +Curl::easy::setopt($curl, CURLOPT_HTTPHEADER, \@myheaders); + +open HEAD, ">head.out"; +Curl::easy::setopt($curl, CURLOPT_WRITEHEADER, *HEAD); +print "ok ".++$count."\n"; + +open BODY, ">body.out"; +Curl::easy::setopt($curl, CURLOPT_FILE,*BODY); +print "ok ".++$count."\n"; + +my $errbuf; +Curl::easy::setopt($curl, CURLOPT_ERRORBUFFER, "errbuf"); +print "ok ".++$count."\n"; + +Curl::easy::setopt($curl, CURLOPT_FORBID_REUSE, 1); + + +print "ok ".++$count."\n"; +Curl::easy::setopt($curl, CURLOPT_CAINFO,"ca-bundle.crt"); + +foreach my $test_list (@$url_list) { + my ($url,$verifypeer,$verifyhost,$result)=@{$test_list}; + print STDERR "testing $url verify=$verifypeer at level $verifyhost expect ".($result?"fail":"pass")."\n"; + + Curl::easy::setopt($curl, CURLOPT_SSL_VERIFYPEER,$verifypeer); # do verify + Curl::easy::setopt($curl, CURLOPT_SSL_VERIFYHOST,$verifyhost); # check name + my $retcode; + + Curl::easy::setopt($curl, CURLOPT_URL, $url); + + $retcode=Curl::easy::perform($curl); + if ( ($retcode != 0) != $result) { + print STDERR "error $retcode $errbuf\n"; + print "not "; + }; + print "ok ".++$count."\n"; + +} diff --git a/perl/Curl_easy/t/Makefile.am b/perl/Curl_easy/t/Makefile.am new file mode 100644 index 000000000..99466ba1d --- /dev/null +++ b/perl/Curl_easy/t/Makefile.am @@ -0,0 +1,2 @@ +EXTRA_DIST = 00constants.t 01basic.t 02header-callback.t 03body-callback.t\ +04abort-test.t 05progress.t 06http-post.t 07ftp-upload.t 08ssl.t diff --git a/perl/Curl_easy/test.pl b/perl/Curl_easy/test.pl deleted file mode 100644 index 91bc48813..000000000 --- a/perl/Curl_easy/test.pl +++ /dev/null @@ -1,321 +0,0 @@ -# Test script for Perl extension Curl::easy. -# Check out the file README for more info. - -# Before `make install' is performed this script should be runnable with -# `make test'. After `make install' it should work as `perl test.pl' - -######################### We start with some black magic to print on failure. - -# Change 1..1 below to 1..last_test_to_print . -# (It may become useful if the test is moved to ./t subdirectory.) -use Benchmark; -use strict; - -BEGIN { $| = 1; print "1..13\n"; } -END {print "not ok 1\n" unless $::loaded;} -use Curl::easy; - -$::loaded = 1; -print "ok 1\n"; - -######################### End of black magic. - -# Insert your test code below (better if it prints "ok 13" -# (correspondingly "not ok 13") depending on the success of chunk 13 -# of the test code): - -print "Testing curl version ",&Curl::easy::version(),"\n"; - -# Read URL to get -my $defurl = "http://localhost/cgi-bin/printenv"; -my $url = ""; -print "Please enter an URL to fetch [$defurl]: "; -$url = ; -if ($url =~ /^\s*\n/) { - $url = $defurl; -} - -# Init the curl session -my $curl; -if (($curl = Curl::easy::init()) != 0) { - print "ok 2\n"; -} else { - print "ko 2\n"; -} - - -# No progress meter please -# !! Need this on for all tests, as once disabled, can't re-enable it... -#Curl::easy::setopt($curl, CURLOPT_NOPROGRESS, 1); - -# Shut up completely -Curl::easy::setopt($curl, CURLOPT_MUTE, 1); - -# Follow location headers -Curl::easy::setopt($curl, CURLOPT_FOLLOWLOCATION, 1); - -# Set timeout -Curl::easy::setopt($curl, CURLOPT_TIMEOUT, 30); - -# Set file where to read cookies from -Curl::easy::setopt($curl, CURLOPT_COOKIEFILE, "cookies"); - -# Set file where to store the header -open HEAD, ">head.out"; -Curl::easy::setopt($curl, CURLOPT_WRITEHEADER, *HEAD); -print "ok 3\n"; - -# Set file where to store the body -# Send body to stdout - test difference between FILE * and SV * -#open BODY, ">body.out"; -#Curl::easy::setopt($curl, CURLOPT_FILE,*BODY); -print "ok 4\n"; - -# Add some additional headers to the http-request: -my @myheaders; -$myheaders[0] = "Server: www"; -$myheaders[1] = "User-Agent: Perl interface for libcURL"; -Curl::easy::setopt($curl, Curl::easy::CURLOPT_HTTPHEADER, \@myheaders); - -# Store error messages in variable $errbuf -# NOTE: The name of the variable is passed as a string! -# setopt() creates a perl variable with that name, and -# perform() stores the errormessage into it if an error occurs. - -Curl::easy::setopt($curl, CURLOPT_ERRORBUFFER, "errbuf"); -Curl::easy::setopt($curl, CURLOPT_URL, $url); -print "ok 5\n"; - -my $bytes; -my $realurl; -my $httpcode; -my $errbuf; - -# Go get it -if (Curl::easy::perform($curl) == 0) { - Curl::easy::getinfo($curl, CURLINFO_SIZE_DOWNLOAD, $bytes); - print "ok 6: $bytes bytes read\n"; - Curl::easy::getinfo($curl, CURLINFO_EFFECTIVE_URL, $realurl); - Curl::easy::getinfo($curl, CURLINFO_HTTP_CODE, $httpcode); - print "effective fetched url (http code: $httpcode) was: $url\n"; -} else { - # We can acces the error message in $errbuf here - print "not ok 6: '$errbuf'\n"; - die "basic url access failed"; -} - -# cleanup -#close HEAD; -# test here - BODY is still expected to be the output -# Curl-easy-1.0.2.pm core dumps if we 'perform' with a closed output FD... -#close BODY; -#exit; -# -# The header callback will only be called if your libcurl has the -# CURLOPT_HEADERFUNCTION supported, otherwise your headers -# go to CURLOPT_WRITEFUNCTION instead... -# - -my $header_called=0; -sub header_callback { print "header callback called\n"; $header_called=1; return length($_[0])}; - -# test for sub reference and head callback -Curl::easy::setopt($curl, CURLOPT_HEADERFUNCTION, \&header_callback); -print "ok 7\n"; # so far so good - -if (Curl::easy::perform($curl) != 0) { - print "not "; -}; -print "ok 8\n"; - -print "next test will fail on libcurl < 7.7.2\n"; -print "not " if (!$header_called); # ok if you have a libcurl <7.7.2 -print "ok 9\n"; - -my $body_called=0; -sub body_callback { - my ($chunk,$handle)=@_; - print "body callback called with ",length($chunk)," bytes\n"; - print "data=$chunk\n"; - $body_called++; - return length($chunk); # OK -} - -# test for ref to sub and body callback -my $body_ref=\&body_callback; -Curl::easy::setopt($curl, CURLOPT_WRITEFUNCTION, $body_ref); - -if (Curl::easy::perform($curl) != 0) { - print "not "; -}; -print "ok 10\n"; - -print "not " if (!$body_called); -print "ok 11\n"; - -my $body_abort_called=0; -sub body_abort_callback { - my ($chunk,$sv)=@_; - print "body abort callback called with ",length($chunk)," bytes\n"; - $body_abort_called++; - return -1; # signal a failure -} - -# test we can abort a request mid-way -my $body_abort_ref=\&body_abort_callback; -Curl::easy::setopt($curl, CURLOPT_WRITEFUNCTION, $body_abort_ref); - -if (Curl::easy::perform($curl) == 0) { # reverse test - this should have failed - print "not "; -}; -print "ok 12\n"; - -print "not " if (!$body_abort_called); # should have been called -print "ok 13\n"; - -# reset to a working 'write' function for next tests -Curl::easy::setopt($curl,CURLOPT_WRITEFUNCTION, sub { return length($_[0])} ); - -# inline progress function -# tests for inline subs and progress callback -# - progress callback must return 'true' on each call. - -my $progress_called=0; -sub prog_callb -{ - my ($clientp,$dltotal,$dlnow,$ultotal,$ulnow)=@_; - print "\nperl progress_callback has been called!\n"; - print "clientp: $clientp, dltotal: $dltotal, dlnow: $dlnow, ultotal: $ultotal, "; - print "ulnow: $ulnow\n"; - $progress_called++; - return 0; -} - -Curl::easy::setopt($curl, CURLOPT_PROGRESSFUNCTION, \&prog_callb); - -# Turn progress meter back on - this doesn't work - once its off, its off. -Curl::easy::setopt($curl, CURLOPT_NOPROGRESS, 0); - -if (Curl::easy::perform($curl) != 0) { - print "not "; -}; -print "ok 14\n"; - -print "not " if (!$progress_called); -print "ok 15\n"; - -my $read_max=10; - -sub read_callb -{ - my ($maxlen,$sv)=@_; - print "\nperl read_callback has been called!\n"; - print "max data size: $maxlen\n"; - print "(upload needs $read_max bytes)\n"; - print "context: ".$sv."\n"; - if ($read_max > 0) { - print "\nEnter max ", $read_max, " characters to be uploaded.\n"; - my $data = ; - chomp $data; - $read_max=$read_max-length($data); - return $data; - } else { - return ""; - } -} - -# -# test post/read callback functions - requires a url which accepts posts, or it fails! -# - -Curl::easy::setopt($curl,CURLOPT_READFUNCTION,\&read_callb); -Curl::easy::setopt($curl,CURLOPT_INFILESIZE,$read_max ); -Curl::easy::setopt($curl,CURLOPT_UPLOAD,1 ); -Curl::easy::setopt($curl,CURLOPT_CUSTOMREQUEST,"POST" ); - -if (Curl::easy::perform($curl) != 0) { - print "not "; -}; -print "ok 16\n"; - -sub passwd_callb -{ - my ($clientp,$prompt,$buflen)=@_; - print "\nperl passwd_callback has been called!\n"; - print "clientp: $clientp, prompt: $prompt, buflen: $buflen\n"; - print "\nEnter max $buflen characters for $prompt "; - my $data = ; - chomp($data); - return (0,$data); -} - -Curl::easy::cleanup($curl); - -# Now do an ftp upload: - -$defurl = "ftp://horn\@localhost//tmp/bla"; -print "\n\nPlease enter an URL for ftp upload [$defurl]: "; -$url = ; -if ($url =~ /^\s*\n/) { - $url = $defurl; -} - -# Init the curl session -if (($curl = Curl::easy::init()) != 0) { - print "ok 17\n"; -} else { - print "not ok 17\n"; -} - -# Set URL to get -if (Curl::easy::setopt($curl, Curl::easy::CURLOPT_URL, $url) == 0) { - print "ok 18\n"; -} else { - print "not ok 18\n"; - -} - -# Tell libcurl to to an upload -Curl::easy::setopt($curl, Curl::easy::CURLOPT_UPLOAD, 1); - -# No progress meter please -#Curl::easy::setopt($curl, Curl::easy::CURLOPT_NOPROGRESS, 1); - -# Use our own progress callback -Curl::easy::setopt($curl, Curl::easy::CURLOPT_PROGRESSFUNCTION, \&prog_callb); - -# Shut up completely -Curl::easy::setopt($curl, Curl::easy::CURLOPT_MUTE, 1); - -# Store error messages in $errbuf -Curl::easy::setopt($curl, Curl::easy::CURLOPT_ERRORBUFFER, "errbuf"); - -$read_max=10; -# Use perl read callback to read data to be uploaded -Curl::easy::setopt($curl, Curl::easy::CURLOPT_READFUNCTION, - \&read_callb); - -# Use perl passwd callback to read password for login to ftp server -Curl::easy::setopt($curl, Curl::easy::CURLOPT_PASSWDFUNCTION, \&passwd_callb); - -print "ok 19\n"; - -# Go get it -if (Curl::easy::perform($curl) == 0) { - Curl::easy::getinfo($curl, Curl::easy::CURLINFO_SIZE_UPLOAD, $bytes); - print "ok 20: $bytes bytes transferred\n\n"; -} else { - # We can acces the error message in $errbuf here - print "not ok 20: '$errbuf'\n"; -} - -# Cleanup -Curl::easy::cleanup($curl); -print "ok 21\n"; - -# Copyright (C) 2000, Daniel Stenberg, , et al. -# You may opt to use, copy, modify, merge, publish, distribute and/or sell -# copies of the Software, and permit persons to whom the Software is -# furnished to do so, under the terms of the MPL or the MIT/X-derivate -# licenses. You may pick one of these licenses. -