mirror of
https://github.com/moparisthebest/curl
synced 2024-08-13 17:03:50 -04:00
Cris Bailiff's and Georg Horn's big improvements
This commit is contained in:
parent
8274bee963
commit
ebcafe73b3
@ -1,6 +1,40 @@
|
|||||||
Revision history for Perl extension Curl::easy.
|
Revision history for Perl extension Curl::easy.
|
||||||
Check out the file README for more info.
|
Check out the file README for more info.
|
||||||
|
|
||||||
|
1.1.3 Wed Apr 18 2001: - Cris Bailiff <c.bailiff@devsecure.com>
|
||||||
|
- Change/shorten module function names:
|
||||||
|
Curl::easy::curl_easy_setopt becomes Curl::easy::setopt etc.
|
||||||
|
This requires minor changes to existing scripts....
|
||||||
|
- Added callback function support to pass arbitrary SV * (including
|
||||||
|
FILE globs) from perl through libcurl to the perl callback.
|
||||||
|
- Make callbacks still work with existing scripts which use STDIO
|
||||||
|
- Initial support for libcurl 7.7.2 HEADERFUNCTION callback feature
|
||||||
|
- Minor API cleanups/changes in the callback function signatures
|
||||||
|
- Added Curl::easy::version function to return curl version string
|
||||||
|
- Callback documentation added in easy.pm
|
||||||
|
- More tests in test.pl
|
||||||
|
|
||||||
|
1.1.2 Mon Apr 16 2001: - Georg Horn <horn@koblenz-net.de>
|
||||||
|
- Added support for callback functions. This is for the curl_easy_setopt()
|
||||||
|
options WRITEFUNCTION, READFUNCTION, PROGRESSFUNCTION and PASSWDFUNCTION.
|
||||||
|
Still missing, but not really neccessary: Passing a FILE * pointer,
|
||||||
|
that is passed in from libcurl, on to the perl callback function.
|
||||||
|
- Various cleanups, fixes and enhancements to easy.xs and test.pl.
|
||||||
|
|
||||||
|
1.1.1 Thu Apr 12 2001:
|
||||||
|
- Made more options of curl_easy_setopt() work: Options that require
|
||||||
|
a list of curl_slist structs to be passed in, like CURLOPT_HTTPHEADER,
|
||||||
|
are now working by passing a perl array containing the list elements.
|
||||||
|
As always, look at the test script test.pl for an example.
|
||||||
|
|
||||||
|
1.1.0 Wed Apr 11 2001:
|
||||||
|
- tested against libcurl 7.7
|
||||||
|
- Added new function Curl::easy::internal_setopt(). By calling
|
||||||
|
Curl::easy::internal_setopt(Curl::easy::USE_INTERNAL_VARS, 1);
|
||||||
|
the headers and content of the fetched page are no longer stored
|
||||||
|
into files (or written to stdout) but are stored into internal
|
||||||
|
Variables $Curl::easy::headers and $Curl::easy::content.
|
||||||
|
|
||||||
1.0.2 Tue Oct 10 2000:
|
1.0.2 Tue Oct 10 2000:
|
||||||
- runs with libcurl 7.4
|
- runs with libcurl 7.4
|
||||||
- modified curl_easy_getinfo(). It now calls curl_getinfo() that has
|
- modified curl_easy_getinfo(). It now calls curl_getinfo() that has
|
||||||
|
@ -8,7 +8,7 @@ WriteMakefile(
|
|||||||
'NAME' => 'Curl::easy',
|
'NAME' => 'Curl::easy',
|
||||||
'VERSION_FROM' => 'easy.pm', # finds $VERSION
|
'VERSION_FROM' => 'easy.pm', # finds $VERSION
|
||||||
'LIBS' => ['-lcurl '], # e.g., '-lm'
|
'LIBS' => ['-lcurl '], # e.g., '-lm'
|
||||||
'DEFINE' => '-Wall', # e.g., '-DHAVE_SOMETHING'
|
'DEFINE' => '', # e.g., '-DHAVE_SOMETHING'
|
||||||
'INC' => '', # e.g., '-I/usr/include/other'
|
'INC' => '', # e.g., '-I/usr/include/other'
|
||||||
'clean' => {FILES => "head.out body.out"}
|
'clean' => {FILES => "head.out body.out"}
|
||||||
);
|
);
|
||||||
|
@ -29,6 +29,7 @@ CURLOPT_FTPASCII
|
|||||||
CURLOPT_FTPLISTONLY
|
CURLOPT_FTPLISTONLY
|
||||||
CURLOPT_FTPPORT
|
CURLOPT_FTPPORT
|
||||||
CURLOPT_HEADER
|
CURLOPT_HEADER
|
||||||
|
CURLOPT_HEADERFUNCTION
|
||||||
CURLOPT_HTTPHEADER
|
CURLOPT_HTTPHEADER
|
||||||
CURLOPT_HTTPPOST
|
CURLOPT_HTTPPOST
|
||||||
CURLOPT_HTTPPROXYTUNNEL
|
CURLOPT_HTTPPROXYTUNNEL
|
||||||
@ -44,6 +45,8 @@ CURLOPT_NETRC
|
|||||||
CURLOPT_NOBODY
|
CURLOPT_NOBODY
|
||||||
CURLOPT_NOPROGRESS
|
CURLOPT_NOPROGRESS
|
||||||
CURLOPT_NOTHING
|
CURLOPT_NOTHING
|
||||||
|
CURLOPT_PASSWDDATA
|
||||||
|
CURLOPT_PASSWDFUNCTION
|
||||||
CURLOPT_PORT
|
CURLOPT_PORT
|
||||||
CURLOPT_POST
|
CURLOPT_POST
|
||||||
CURLOPT_POSTFIELDS
|
CURLOPT_POSTFIELDS
|
||||||
@ -88,8 +91,14 @@ CURLINFO_SPEED_DOWNLOAD
|
|||||||
CURLINFO_SPEED_UPLOAD
|
CURLINFO_SPEED_UPLOAD
|
||||||
CURLINFO_HEADER_SIZE
|
CURLINFO_HEADER_SIZE
|
||||||
CURLINFO_REQUEST_SIZE
|
CURLINFO_REQUEST_SIZE
|
||||||
|
|
||||||
|
USE_INTERNAL_VARS
|
||||||
);
|
);
|
||||||
$VERSION = '1.0.1';
|
|
||||||
|
$VERSION = '1.1.3';
|
||||||
|
|
||||||
|
$Curl::easy::headers = "";
|
||||||
|
$Curl::easy::content = "";
|
||||||
|
|
||||||
sub AUTOLOAD {
|
sub AUTOLOAD {
|
||||||
# This AUTOLOAD is used to 'autoload' constants from the constant()
|
# This AUTOLOAD is used to 'autoload' constants from the constant()
|
||||||
@ -117,21 +126,122 @@ Curl::easy - Perl extension for libcurl
|
|||||||
|
|
||||||
use Curl::easy;
|
use Curl::easy;
|
||||||
|
|
||||||
$CURL = curl_easy_init();
|
$curl = Curl::easy::init();
|
||||||
$CURLcode = curl_easy_setopt($CURL, CURLoption, Value);
|
$CURLcode = Curl::easy::setopt($curl, CURLoption, Value);
|
||||||
$CURLcode = curl_easy_perform($CURL);
|
$CURLcode = Curl::easy::perform($curl);
|
||||||
curl_easy_cleanup($CURL);
|
Curl::easy::cleanup($curl);
|
||||||
|
|
||||||
|
|
||||||
=head1 DESCRIPTION
|
=head1 DESCRIPTION
|
||||||
|
|
||||||
This perl module provides an interface to the libcurl C library. See
|
This perl module provides an interface to the libcurl C library. See
|
||||||
http://curl.haxx.se/ for more information on cURL and libcurl.
|
http://curl.haxx.se/ for more information on cURL and libcurl.
|
||||||
|
|
||||||
|
=head1 FILES and CALLBACKS
|
||||||
|
|
||||||
|
Curl::easy supports the various options of curl_easy_setopt which require either a FILE * or
|
||||||
|
a callback function.
|
||||||
|
|
||||||
|
The perl callback functions are handled through a C wrapper which takes care of converting
|
||||||
|
from C to perl variables and back again. This wrapper simplifies some C arguments to make
|
||||||
|
them behave in a more 'perl' like manner. In particular, the read and write callbacks do not
|
||||||
|
look just like the 'fread' and 'fwrite' C functions - perl variables do not need separate length
|
||||||
|
parameters, and perl functions can return a list of variables, instead of needing a pointer
|
||||||
|
to modify. The details are described below.
|
||||||
|
|
||||||
|
=head2 FILE handles (GLOBS)
|
||||||
|
|
||||||
|
Curl options which take a FILE, such as CURLOPT_FILE, CURLOPT_WRITEHEADER, CURLOPT_INFILE
|
||||||
|
can be passed a perl file handle:
|
||||||
|
|
||||||
|
open BODY,">body.out";
|
||||||
|
$CURLcode = Curl::easy::setopt($curl, CURLOPT_FILE, BODY);
|
||||||
|
|
||||||
|
=head2 WRITE callback
|
||||||
|
|
||||||
|
The CUROPT_WRITEFUNCTION option may be set which will cause libcurl to callback to
|
||||||
|
the given subroutine:
|
||||||
|
|
||||||
|
sub chunk { my ($data,$pointer)=@_; ...; return length($data) }
|
||||||
|
$CURLcode = Curl::easy::setopt($curl, CURLOPT_WRITEFUNCTION, \&chunk );
|
||||||
|
$CURLcode = Curl::easy::setopt($curl, CURLOPT_FILE, );
|
||||||
|
|
||||||
|
In this case, the subroutine will be passed whatever is defined by CURLOPT_FILE. This can be
|
||||||
|
a ref to a scalar, or a GLOB or anything else you like.
|
||||||
|
|
||||||
|
The callback function must return the number of bytes 'handled' ( length($data) ) or the transfer
|
||||||
|
will abort. A transfer can be aborted by returning a 'length' of '-1'.
|
||||||
|
|
||||||
|
The option CURLOPT_WRITEHEADER can be set to pass a different '$pointer' into the CURLOPT_WRITEFUNCTION
|
||||||
|
for header values. This lets you collect the headers and body separately:
|
||||||
|
|
||||||
|
my $headers="";
|
||||||
|
my $body="";
|
||||||
|
sub chunk { my ($data,$pointer)=@_; ${$pointer}.=$data; return length($data) }
|
||||||
|
|
||||||
|
$CURLcode = Curl::easy::setopt($curl, CURLOPT_WRITEFUNCTION, \&chunk );
|
||||||
|
$CURLcode = Curl::easy::setopt($curl, CURLOPT_WRITEHEADER, \$header );
|
||||||
|
$CURLcode = Curl::easy::setopt($curl, CURLOPT_FILE, \$body );
|
||||||
|
|
||||||
|
If you have libcurl > 7.7.1, then you could instead set CURLOPT_HEADERFUNCTION to a different callback,
|
||||||
|
and have the header collected that way.
|
||||||
|
|
||||||
|
=head2 READ callback
|
||||||
|
|
||||||
|
Curl::easy supports CURLOPT_READFUNCTION. This function should look something like this:
|
||||||
|
|
||||||
|
sub read_callback {
|
||||||
|
my ($maxlength,$pointer)=@_;
|
||||||
|
|
||||||
|
....
|
||||||
|
|
||||||
|
return $data;
|
||||||
|
}
|
||||||
|
|
||||||
|
The subroutine must return an empty string "" at the end of the data. Note that this function
|
||||||
|
isn't told how much data to provide - $maxlength is just the maximum size of the buffer
|
||||||
|
provided by libcurl. If you are doing an HTTP POST or PUT for example, it is important that this
|
||||||
|
function only returns as much data as the 'Content-Length' header specifies, followed by a
|
||||||
|
an empty (0 length) buffer.
|
||||||
|
|
||||||
|
=head2 PROGRESS callback
|
||||||
|
|
||||||
|
Curl::easy supports CURLOPT_PROGRESSFUNCTION. This function should look something like this:
|
||||||
|
|
||||||
|
sub prog_callb
|
||||||
|
{
|
||||||
|
my ($clientp,$dltotal,$dlnow,$ultotal,$ulnow)=@_;
|
||||||
|
....
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
The function should return 0 normally, or -1 which will abort/cancel the transfer. $clientp is whatever
|
||||||
|
value/scalar is set using the CURLOPT_PROGRESSDATA option.
|
||||||
|
|
||||||
|
=head2 PASSWD callback
|
||||||
|
|
||||||
|
Curl::easy supports CURLOPT_PASSWDFUNCTION. This function should look something like this:
|
||||||
|
|
||||||
|
sub passwd_callb
|
||||||
|
{
|
||||||
|
my ($clientp,$prompt,$buflen)=@_;
|
||||||
|
...
|
||||||
|
return (0,$data);
|
||||||
|
}
|
||||||
|
|
||||||
|
$clientp is whatever scalar is set using the CURLOPT_PASSWDDATA option.
|
||||||
|
$prompt is a text string which can be used to prompt for a password.
|
||||||
|
$buflen is the maximum accepted password reply.
|
||||||
|
|
||||||
|
The function must return 0 (for 'OK') and the password data as a list. Return (-1,"") to
|
||||||
|
indicate an error.
|
||||||
|
|
||||||
=head1 AUTHOR
|
=head1 AUTHOR
|
||||||
|
|
||||||
Georg Horn <horn@koblenz-net.de>
|
Georg Horn <horn@koblenz-net.de>
|
||||||
|
|
||||||
|
Additional callback,pod and tes work by Cris Bailiff <c.bailiff@devsecure.com>
|
||||||
|
and Forrest Cahoon <forrest.cahoon@merrillcorp.com>
|
||||||
|
|
||||||
=head1 SEE ALSO
|
=head1 SEE ALSO
|
||||||
|
|
||||||
http://curl.haxx.se/
|
http://curl.haxx.se/
|
||||||
|
@ -7,6 +7,17 @@
|
|||||||
#include <curl/curl.h>
|
#include <curl/curl.h>
|
||||||
#include <curl/easy.h>
|
#include <curl/easy.h>
|
||||||
|
|
||||||
|
#if (LIBCURL_VERSION_NUM<0x070702)
|
||||||
|
#define CURLOPT_HEADERFUNCTION 79
|
||||||
|
#define header_callback_func write_callback_func
|
||||||
|
#else
|
||||||
|
#define header_callback_func writeheader_callback_func
|
||||||
|
#endif
|
||||||
|
|
||||||
|
/* Lists that can be set via curl_easy_setopt() */
|
||||||
|
|
||||||
|
static struct curl_slist *httpheader = NULL, *quote = NULL, *postquote = NULL;
|
||||||
|
|
||||||
|
|
||||||
/* Buffer and varname for option CURLOPT_ERRORBUFFER */
|
/* Buffer and varname for option CURLOPT_ERRORBUFFER */
|
||||||
|
|
||||||
@ -14,6 +25,341 @@ static char errbuf[CURL_ERROR_SIZE];
|
|||||||
static char *errbufvarname = NULL;
|
static char *errbufvarname = NULL;
|
||||||
|
|
||||||
|
|
||||||
|
/* Callback functions */
|
||||||
|
|
||||||
|
static SV *read_callback = NULL, *write_callback = NULL,
|
||||||
|
*progress_callback = NULL, *passwd_callback = NULL,
|
||||||
|
*header_callback = NULL;
|
||||||
|
/* *closepolicy_callback = NULL; */
|
||||||
|
|
||||||
|
|
||||||
|
/* For storing the content */
|
||||||
|
|
||||||
|
static char *contbuf = NULL, *bufptr = NULL;
|
||||||
|
static int bufsize = 32768, contlen = 0;
|
||||||
|
|
||||||
|
|
||||||
|
/* Internal options for this perl module */
|
||||||
|
|
||||||
|
#define USE_INTERNAL_VARS 0x01
|
||||||
|
|
||||||
|
static int internal_options = 0;
|
||||||
|
|
||||||
|
|
||||||
|
/* Setup these global vars */
|
||||||
|
|
||||||
|
static void init_globals(void)
|
||||||
|
{
|
||||||
|
if (httpheader) curl_slist_free_all(httpheader);
|
||||||
|
if (quote) curl_slist_free_all(quote);
|
||||||
|
if (postquote) curl_slist_free_all(postquote);
|
||||||
|
httpheader = quote = postquote = NULL;
|
||||||
|
if (errbufvarname) free(errbufvarname);
|
||||||
|
errbufvarname = NULL;
|
||||||
|
if (contbuf == NULL) {
|
||||||
|
contbuf = malloc(bufsize + 1);
|
||||||
|
}
|
||||||
|
bufptr = contbuf;
|
||||||
|
*bufptr = '\0';
|
||||||
|
contlen = 0;
|
||||||
|
internal_options = 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
/* Register a callback function */
|
||||||
|
|
||||||
|
static void register_callback(SV **callback, SV *function)
|
||||||
|
{
|
||||||
|
if (*callback == NULL) {
|
||||||
|
/* First time, create new SV */
|
||||||
|
*callback = newSVsv(function);
|
||||||
|
} else {
|
||||||
|
/* Been there, done that. Just overwrite the SV */
|
||||||
|
SvSetSV(*callback, function);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
/* generic fwrite callback, which decides which callback to call */
|
||||||
|
static size_t
|
||||||
|
fwrite_wrapper (const void *ptr,
|
||||||
|
size_t size,
|
||||||
|
size_t nmemb,
|
||||||
|
void *stream,
|
||||||
|
void *call_function)
|
||||||
|
{
|
||||||
|
dSP ;
|
||||||
|
int count,status;
|
||||||
|
SV *sv;
|
||||||
|
|
||||||
|
if (call_function) {
|
||||||
|
/* then we are doing a callback to perl */
|
||||||
|
|
||||||
|
ENTER ;
|
||||||
|
SAVETMPS ;
|
||||||
|
|
||||||
|
PUSHMARK(SP) ;
|
||||||
|
|
||||||
|
if (stream == stdout) {
|
||||||
|
sv = newSViv(0); /* FIXME: should cast stdout to GLOB somehow? */
|
||||||
|
} else { /* its already an SV */
|
||||||
|
sv = stream;
|
||||||
|
}
|
||||||
|
|
||||||
|
if (ptr != NULL) {
|
||||||
|
XPUSHs(sv_2mortal(newSVpvn(ptr, size * nmemb)));
|
||||||
|
} else {
|
||||||
|
XPUSHs(sv_2mortal(newSVpv("",0)));
|
||||||
|
}
|
||||||
|
XPUSHs(sv_2mortal(newSVsv(sv))); /* CURLOPT_FILE SV* */
|
||||||
|
PUTBACK ;
|
||||||
|
|
||||||
|
count = call_sv((SV *)call_function, G_SCALAR);
|
||||||
|
|
||||||
|
SPAGAIN;
|
||||||
|
if (count != 1)
|
||||||
|
croak("Big trouble, perl_call_sv(write_callback) didn't return status\n");
|
||||||
|
|
||||||
|
status = POPi;
|
||||||
|
|
||||||
|
PUTBACK ;
|
||||||
|
|
||||||
|
FREETMPS ;
|
||||||
|
LEAVE ;
|
||||||
|
return status;
|
||||||
|
|
||||||
|
} else {
|
||||||
|
/* default to a normal 'fwrite' */
|
||||||
|
/* stream could be a FILE * or an SV * */
|
||||||
|
FILE *f;
|
||||||
|
|
||||||
|
if (stream == stdout) { /* the only possible FILE ? Think so*/
|
||||||
|
f = stream;
|
||||||
|
} else { /* its a GLOB */
|
||||||
|
f = IoIFP(sv_2io(stream)); /* may barf if not a GLOB */
|
||||||
|
}
|
||||||
|
|
||||||
|
return fwrite(ptr,size,nmemb,f);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Write callback for calling a perl callback */
|
||||||
|
size_t
|
||||||
|
write_callback_func( const void *ptr, size_t size,
|
||||||
|
size_t nmemb, void *stream)
|
||||||
|
{
|
||||||
|
return fwrite_wrapper(ptr,size,nmemb,stream,
|
||||||
|
write_callback);
|
||||||
|
}
|
||||||
|
|
||||||
|
/* header callback for calling a perl callback */
|
||||||
|
size_t
|
||||||
|
writeheader_callback_func( const void *ptr, size_t size,
|
||||||
|
size_t nmemb, void *stream)
|
||||||
|
{
|
||||||
|
return fwrite_wrapper(ptr,size,nmemb,stream,
|
||||||
|
header_callback);
|
||||||
|
}
|
||||||
|
|
||||||
|
size_t
|
||||||
|
read_callback_func( void *ptr, size_t size,
|
||||||
|
size_t nmemb, void *stream)
|
||||||
|
{
|
||||||
|
dSP ;
|
||||||
|
|
||||||
|
int count;
|
||||||
|
SV *sv;
|
||||||
|
STRLEN len;
|
||||||
|
size_t maxlen,mylen;
|
||||||
|
char *p;
|
||||||
|
|
||||||
|
maxlen = size*nmemb;
|
||||||
|
|
||||||
|
if (read_callback) {
|
||||||
|
/* we are doing a callback to perl */
|
||||||
|
|
||||||
|
ENTER ;
|
||||||
|
SAVETMPS ;
|
||||||
|
|
||||||
|
PUSHMARK(SP) ;
|
||||||
|
|
||||||
|
if (stream == stdin) {
|
||||||
|
sv = newSViv(0); /* should cast stdin to GLOB somehow? */
|
||||||
|
} else { /* its an SV */
|
||||||
|
sv = stream;
|
||||||
|
}
|
||||||
|
|
||||||
|
XPUSHs(sv_2mortal(newSViv(maxlen))); /* send how many bytes please */
|
||||||
|
XPUSHs(sv_2mortal(newSVsv(sv))); /* CURLOPT_INFILE SV* */
|
||||||
|
PUTBACK ;
|
||||||
|
|
||||||
|
count = call_sv(read_callback, G_SCALAR);
|
||||||
|
|
||||||
|
SPAGAIN;
|
||||||
|
if (count != 1)
|
||||||
|
croak("Big trouble, perl_call_sv(read_callback) didn't return data\n");
|
||||||
|
|
||||||
|
sv = POPs;
|
||||||
|
p = SvPV(sv,len);
|
||||||
|
|
||||||
|
/* only allowed to return the number of bytes asked for */
|
||||||
|
mylen = len<maxlen ? len : maxlen;
|
||||||
|
memcpy(ptr,p,(size_t)mylen);
|
||||||
|
PUTBACK ;
|
||||||
|
|
||||||
|
FREETMPS ;
|
||||||
|
LEAVE ;
|
||||||
|
return (size_t) (mylen/size);
|
||||||
|
|
||||||
|
} else {
|
||||||
|
/* default to a normal 'fread' */
|
||||||
|
/* stream could be a FILE * or an SV * */
|
||||||
|
FILE *f;
|
||||||
|
|
||||||
|
if (stream == stdin) { /* the only possible FILE ? Think so*/
|
||||||
|
f = stream;
|
||||||
|
} else { /* its a GLOB */
|
||||||
|
f = IoIFP(sv_2io(stream)); /* may barf if not a GLOB */
|
||||||
|
}
|
||||||
|
|
||||||
|
return fread(ptr,size,nmemb,f);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Porgress callback for calling a perl callback */
|
||||||
|
|
||||||
|
static int progress_callback_func(void *clientp, size_t dltotal, size_t dlnow,
|
||||||
|
size_t ultotal, size_t ulnow)
|
||||||
|
{
|
||||||
|
dSP;
|
||||||
|
int count;
|
||||||
|
|
||||||
|
ENTER;
|
||||||
|
SAVETMPS;
|
||||||
|
PUSHMARK(sp);
|
||||||
|
if (clientp != NULL) {
|
||||||
|
XPUSHs(sv_2mortal(newSVpv(clientp, 0)));
|
||||||
|
} else {
|
||||||
|
XPUSHs(sv_2mortal(newSVpv("", 0)));
|
||||||
|
}
|
||||||
|
XPUSHs(sv_2mortal(newSViv(dltotal)));
|
||||||
|
XPUSHs(sv_2mortal(newSViv(dlnow)));
|
||||||
|
XPUSHs(sv_2mortal(newSViv(ultotal)));
|
||||||
|
XPUSHs(sv_2mortal(newSViv(ulnow)));
|
||||||
|
PUTBACK;
|
||||||
|
count = perl_call_sv(progress_callback, G_SCALAR);
|
||||||
|
SPAGAIN;
|
||||||
|
if (count != 1)
|
||||||
|
croak("Big trouble, perl_call_sv(progress_callback) didn't return 1\n");
|
||||||
|
count = POPi;
|
||||||
|
PUTBACK;
|
||||||
|
FREETMPS;
|
||||||
|
LEAVE;
|
||||||
|
return count;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
/* Password callback for calling a perl callback */
|
||||||
|
|
||||||
|
static int passwd_callback_func(void *clientp, char *prompt, char *buffer,
|
||||||
|
int buflen)
|
||||||
|
{
|
||||||
|
dSP;
|
||||||
|
int count;
|
||||||
|
SV *sv;
|
||||||
|
STRLEN len;
|
||||||
|
size_t mylen;
|
||||||
|
char *p;
|
||||||
|
|
||||||
|
ENTER;
|
||||||
|
SAVETMPS;
|
||||||
|
PUSHMARK(sp);
|
||||||
|
if (clientp != NULL) {
|
||||||
|
XPUSHs(sv_2mortal(newSVsv(clientp)));
|
||||||
|
} else {
|
||||||
|
XPUSHs(sv_2mortal(newSVpv("", 0)));
|
||||||
|
}
|
||||||
|
XPUSHs(sv_2mortal(newSVpv(prompt, 0)));
|
||||||
|
XPUSHs(sv_2mortal(newSViv(buflen)));
|
||||||
|
PUTBACK;
|
||||||
|
count = perl_call_sv(passwd_callback, G_ARRAY);
|
||||||
|
SPAGAIN;
|
||||||
|
if (count != 2)
|
||||||
|
croak("Big trouble, perl_call_sv(passwd_callback) didn't return status + data\n");
|
||||||
|
|
||||||
|
sv = POPs;
|
||||||
|
count = POPi;
|
||||||
|
|
||||||
|
p = SvPV(sv,len);
|
||||||
|
|
||||||
|
/* only allowed to return the number of bytes asked for */
|
||||||
|
mylen = len<(buflen-1) ? len : (buflen-1);
|
||||||
|
memcpy(buffer,p,mylen);
|
||||||
|
buffer[buflen]=0; /* ensure C string terminates */
|
||||||
|
|
||||||
|
PUTBACK;
|
||||||
|
FREETMPS;
|
||||||
|
LEAVE;
|
||||||
|
return count;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
#if 0
|
||||||
|
/* awaiting closepolicy prototype */
|
||||||
|
int
|
||||||
|
closepolicy_callback_func(void *clientp)
|
||||||
|
{
|
||||||
|
dSP;
|
||||||
|
int argc, status;
|
||||||
|
SV *pl_status;
|
||||||
|
|
||||||
|
ENTER;
|
||||||
|
SAVETMPS;
|
||||||
|
|
||||||
|
PUSHMARK(SP);
|
||||||
|
PUTBACK;
|
||||||
|
|
||||||
|
argc = call_sv(closepolicy_callback, G_SCALAR);
|
||||||
|
SPAGAIN;
|
||||||
|
|
||||||
|
if (argc != 1) {
|
||||||
|
croak
|
||||||
|
("Unexpected number of arguments returned from closefunction callback\n");
|
||||||
|
}
|
||||||
|
pl_status = POPs;
|
||||||
|
status = SvTRUE(pl_status) ? 0 : 1;
|
||||||
|
|
||||||
|
PUTBACK;
|
||||||
|
FREETMPS;
|
||||||
|
LEAVE;
|
||||||
|
|
||||||
|
return status;
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
/* Internal write callback. Only used if USE_INTERNAL_VARS was specified */
|
||||||
|
|
||||||
|
static size_t internal_write_callback(char *data, size_t size, size_t num,
|
||||||
|
FILE *fp)
|
||||||
|
{
|
||||||
|
int i;
|
||||||
|
|
||||||
|
size *= num;
|
||||||
|
if ((contlen + size) >= bufsize) {
|
||||||
|
bufsize *= 2;
|
||||||
|
contbuf = realloc(contbuf, bufsize + 1);
|
||||||
|
bufptr = contbuf + contlen;
|
||||||
|
}
|
||||||
|
contlen += size;
|
||||||
|
for (i = 0; i < size; i++) {
|
||||||
|
*bufptr++ = *data++;
|
||||||
|
}
|
||||||
|
*bufptr = '\0';
|
||||||
|
return size;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
static int
|
static int
|
||||||
constant(char *name, int arg)
|
constant(char *name, int arg)
|
||||||
{
|
{
|
||||||
@ -97,6 +443,7 @@ constant(char *name, int arg)
|
|||||||
case 'G':
|
case 'G':
|
||||||
case 'H':
|
case 'H':
|
||||||
if (strEQ(name, "HEADER")) return CURLOPT_HEADER;
|
if (strEQ(name, "HEADER")) return CURLOPT_HEADER;
|
||||||
|
if (strEQ(name, "HEADERFUNCTION")) return CURLOPT_HEADERFUNCTION;
|
||||||
if (strEQ(name, "HTTPHEADER")) return CURLOPT_HTTPHEADER;
|
if (strEQ(name, "HTTPHEADER")) return CURLOPT_HTTPHEADER;
|
||||||
if (strEQ(name, "HTTPPOST")) return CURLOPT_HTTPPOST;
|
if (strEQ(name, "HTTPPOST")) return CURLOPT_HTTPPOST;
|
||||||
if (strEQ(name, "HTTPPROXYTUNNEL")) return CURLOPT_HTTPPROXYTUNNEL;
|
if (strEQ(name, "HTTPPROXYTUNNEL")) return CURLOPT_HTTPPROXYTUNNEL;
|
||||||
@ -124,6 +471,8 @@ constant(char *name, int arg)
|
|||||||
break;
|
break;
|
||||||
case 'O':
|
case 'O':
|
||||||
case 'P':
|
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, "PORT")) return CURLOPT_PORT;
|
||||||
if (strEQ(name, "POST")) return CURLOPT_POST;
|
if (strEQ(name, "POST")) return CURLOPT_POST;
|
||||||
if (strEQ(name, "POSTFIELDS")) return CURLOPT_POSTFIELDS;
|
if (strEQ(name, "POSTFIELDS")) return CURLOPT_POSTFIELDS;
|
||||||
@ -173,12 +522,13 @@ constant(char *name, int arg)
|
|||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
if (strEQ(name, "USE_INTERNAL_VARS")) return USE_INTERNAL_VARS;
|
||||||
errno = EINVAL;
|
errno = EINVAL;
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
MODULE = Curl::easy PACKAGE = Curl::easy
|
MODULE = Curl::easy PACKAGE = Curl::easy PREFIX = curl_easy_
|
||||||
|
|
||||||
int
|
int
|
||||||
constant(name,arg)
|
constant(name,arg)
|
||||||
@ -189,43 +539,119 @@ constant(name,arg)
|
|||||||
void *
|
void *
|
||||||
curl_easy_init()
|
curl_easy_init()
|
||||||
CODE:
|
CODE:
|
||||||
if (errbufvarname) free(errbufvarname);
|
init_globals();
|
||||||
errbufvarname = NULL;
|
|
||||||
RETVAL = curl_easy_init();
|
RETVAL = curl_easy_init();
|
||||||
|
curl_easy_setopt(RETVAL, CURLOPT_HEADERFUNCTION, header_callback_func);
|
||||||
|
curl_easy_setopt(RETVAL, CURLOPT_WRITEFUNCTION, write_callback_func);
|
||||||
OUTPUT:
|
OUTPUT:
|
||||||
RETVAL
|
RETVAL
|
||||||
|
|
||||||
|
char *
|
||||||
|
curl_easy_version()
|
||||||
|
CODE:
|
||||||
|
RETVAL=curl_version();
|
||||||
|
OUTPUT:
|
||||||
|
RETVAL
|
||||||
|
|
||||||
int
|
int
|
||||||
curl_easy_setopt(curl, option, value)
|
curl_easy_setopt(curl, option, value)
|
||||||
void * curl
|
void * curl
|
||||||
int option
|
int option
|
||||||
char * value
|
SV * value
|
||||||
CODE:
|
CODE:
|
||||||
if (option < CURLOPTTYPE_OBJECTPOINT) {
|
if (option < CURLOPTTYPE_OBJECTPOINT) {
|
||||||
|
|
||||||
/* This is an option specifying an integer value: */
|
/* This is an option specifying an integer value: */
|
||||||
long value = (long)SvIV(ST(2));
|
RETVAL = curl_easy_setopt(curl, option, (long)SvIV(value));
|
||||||
RETVAL = curl_easy_setopt(curl, option, value);
|
|
||||||
} else if (option == CURLOPT_FILE || option == CURLOPT_INFILE ||
|
} else if (option == CURLOPT_FILE || option == CURLOPT_INFILE ||
|
||||||
option == CURLOPT_WRITEHEADER) {
|
option == CURLOPT_WRITEHEADER || option == CURLOPT_PROGRESSDATA ||
|
||||||
/* This is an option specifying a FILE * value: */
|
option == CURLOPT_PASSWDDATA) {
|
||||||
FILE * value = IoIFP(sv_2io(ST(2)));
|
/* This is an option specifying an SV * value: */
|
||||||
RETVAL = curl_easy_setopt(curl, option, value);
|
RETVAL = curl_easy_setopt(curl, option, newSVsv(ST(2)));
|
||||||
|
|
||||||
} else if (option == CURLOPT_ERRORBUFFER) {
|
} else if (option == CURLOPT_ERRORBUFFER) {
|
||||||
SV *sv;
|
/* Pass in variable name for storing error messages... */
|
||||||
RETVAL = curl_easy_setopt(curl, option, errbuf);
|
RETVAL = curl_easy_setopt(curl, option, errbuf);
|
||||||
if (errbufvarname) free(errbufvarname);
|
if (errbufvarname) free(errbufvarname);
|
||||||
errbufvarname = strdup(value);
|
errbufvarname = strdup((char *)SvPV(value, PL_na));
|
||||||
sv = perl_get_sv(errbufvarname, TRUE | GV_ADDMULTI);
|
|
||||||
} else if (option == CURLOPT_WRITEFUNCTION || option ==
|
} else if (option == CURLOPT_WRITEFUNCTION || option ==
|
||||||
CURLOPT_READFUNCTION || option == CURLOPT_PROGRESSFUNCTION) {
|
CURLOPT_READFUNCTION || option == CURLOPT_PROGRESSFUNCTION ||
|
||||||
|
option == CURLOPT_PASSWDFUNCTION || option == CURLOPT_HEADERFUNCTION) {
|
||||||
/* This is an option specifying a callback function */
|
/* This is an option specifying a callback function */
|
||||||
/* not yet implemented */
|
switch (option) {
|
||||||
RETVAL = -1;
|
case CURLOPT_WRITEFUNCTION:
|
||||||
} else {
|
register_callback(&write_callback, value);
|
||||||
/* default, option specifying a char * value: */
|
curl_easy_setopt(curl, CURLOPT_WRITEFUNCTION, write_callback_func);
|
||||||
RETVAL = curl_easy_setopt(curl, option, value);
|
break;
|
||||||
|
case CURLOPT_READFUNCTION:
|
||||||
|
register_callback(&read_callback, value);
|
||||||
|
curl_easy_setopt(curl, CURLOPT_READFUNCTION, read_callback_func);
|
||||||
|
break;
|
||||||
|
case CURLOPT_HEADERFUNCTION:
|
||||||
|
register_callback(&header_callback, value);
|
||||||
|
curl_easy_setopt(curl, CURLOPT_HEADERFUNCTION, header_callback_func);
|
||||||
|
case CURLOPT_PROGRESSFUNCTION:
|
||||||
|
register_callback(&progress_callback, value);
|
||||||
|
curl_easy_setopt(curl, CURLOPT_PROGRESSFUNCTION, progress_callback_func);
|
||||||
|
break;
|
||||||
|
case CURLOPT_PASSWDFUNCTION:
|
||||||
|
register_callback(&passwd_callback, value);
|
||||||
|
curl_easy_setopt(curl, CURLOPT_PASSWDFUNCTION, passwd_callback_func);
|
||||||
|
break;
|
||||||
|
/* awaiting a prototype for the closepolicy function callback
|
||||||
|
case CURLOPT_CLOSEFUNCTION:
|
||||||
|
register_callback(&closepolicy_callback, value);
|
||||||
|
curl_easy_setopt(curl, CURLOPT_CLOSEFUNCTION, closepolicy_callback_func);
|
||||||
|
break;
|
||||||
|
*/
|
||||||
}
|
}
|
||||||
|
RETVAL = -1;
|
||||||
|
|
||||||
|
} else if (option == CURLOPT_HTTPHEADER || option == CURLOPT_QUOTE ||
|
||||||
|
option == CURLOPT_POSTQUOTE) {
|
||||||
|
/* This is an option specifying a list of curl_slist structs: */
|
||||||
|
AV *array = (AV *)SvRV(value);
|
||||||
|
struct curl_slist **slist = NULL;
|
||||||
|
/* We have to find out which list to use... */
|
||||||
|
switch (option) {
|
||||||
|
case CURLOPT_HTTPHEADER:
|
||||||
|
slist = &httpheader; break;
|
||||||
|
case CURLOPT_QUOTE:
|
||||||
|
slist = "e; break;
|
||||||
|
case CURLOPT_POSTQUOTE:
|
||||||
|
slist = &postquote; break;
|
||||||
|
}
|
||||||
|
/* ...store the values into it... */
|
||||||
|
for (;;) {
|
||||||
|
SV *sv = av_shift(array);
|
||||||
|
int len = 0;
|
||||||
|
char *str = SvPV(sv, len);
|
||||||
|
if (len == 0) break;
|
||||||
|
*slist = curl_slist_append(*slist, str);
|
||||||
|
}
|
||||||
|
/* ...and pass the list into curl_easy_setopt() */
|
||||||
|
RETVAL = curl_easy_setopt(curl, option, *slist);
|
||||||
|
} else {
|
||||||
|
/* This is an option specifying a char * value: */
|
||||||
|
RETVAL = curl_easy_setopt(curl, option, SvPV(value, PL_na));
|
||||||
|
}
|
||||||
|
OUTPUT:
|
||||||
|
RETVAL
|
||||||
|
|
||||||
|
|
||||||
|
int
|
||||||
|
internal_setopt(option, value)
|
||||||
|
int option
|
||||||
|
int value
|
||||||
|
CODE:
|
||||||
|
if (value == 1) {
|
||||||
|
internal_options |= option;
|
||||||
|
} else {
|
||||||
|
internal_options &= !option;
|
||||||
|
}
|
||||||
|
RETVAL = 0;
|
||||||
OUTPUT:
|
OUTPUT:
|
||||||
RETVAL
|
RETVAL
|
||||||
|
|
||||||
@ -234,11 +660,46 @@ int
|
|||||||
curl_easy_perform(curl)
|
curl_easy_perform(curl)
|
||||||
void * curl
|
void * curl
|
||||||
CODE:
|
CODE:
|
||||||
|
if (internal_options & USE_INTERNAL_VARS) {
|
||||||
|
/* Use internal callback which just stores the content into a buffer. */
|
||||||
|
curl_easy_setopt(curl, CURLOPT_WRITEFUNCTION, internal_write_callback);
|
||||||
|
curl_easy_setopt(curl, CURLOPT_HEADER, 1);
|
||||||
|
}
|
||||||
RETVAL = curl_easy_perform(curl);
|
RETVAL = curl_easy_perform(curl);
|
||||||
if (RETVAL && errbufvarname) {
|
if (RETVAL && errbufvarname) {
|
||||||
|
/* If an error occurred and a varname for error messages has been
|
||||||
|
specified, store the error message. */
|
||||||
SV *sv = perl_get_sv(errbufvarname, TRUE | GV_ADDMULTI);
|
SV *sv = perl_get_sv(errbufvarname, TRUE | GV_ADDMULTI);
|
||||||
sv_setpv(sv, errbuf);
|
sv_setpv(sv, errbuf);
|
||||||
}
|
}
|
||||||
|
if (!RETVAL && (internal_options & USE_INTERNAL_VARS)) {
|
||||||
|
/* No error and internal variable for the content are to be used:
|
||||||
|
Split the data into headers and content and store them into
|
||||||
|
perl variables. */
|
||||||
|
SV *head_sv = perl_get_sv("Curl::easy::headers", TRUE | GV_ADDMULTI);
|
||||||
|
SV *cont_sv = perl_get_sv("Curl::easy::content", TRUE | GV_ADDMULTI);
|
||||||
|
char *p = contbuf;
|
||||||
|
int nl = 0, found = 0;
|
||||||
|
while (p < bufptr) {
|
||||||
|
if (nl && (*p == '\n' || *p == '\r')) {
|
||||||
|
/* found empty line, end of headers */
|
||||||
|
*p++ = '\0';
|
||||||
|
sv_setpv(head_sv, contbuf);
|
||||||
|
while (*p == '\n' || *p == '\r') {
|
||||||
|
p++;
|
||||||
|
}
|
||||||
|
sv_setpv(cont_sv, p);
|
||||||
|
found = 1;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
nl = (*p == '\n');
|
||||||
|
p++;
|
||||||
|
}
|
||||||
|
if (!found) {
|
||||||
|
sv_setpv(head_sv, "");
|
||||||
|
sv_setpv(cont_sv, contbuf);
|
||||||
|
}
|
||||||
|
}
|
||||||
OUTPUT:
|
OUTPUT:
|
||||||
RETVAL
|
RETVAL
|
||||||
|
|
||||||
@ -249,6 +710,10 @@ void * curl
|
|||||||
int option
|
int option
|
||||||
double value
|
double value
|
||||||
CODE:
|
CODE:
|
||||||
|
#ifdef __GNUC__
|
||||||
|
/* a(void) warnig about unnused variable */
|
||||||
|
(void) value;
|
||||||
|
#endif
|
||||||
switch (option & CURLINFO_TYPEMASK) {
|
switch (option & CURLINFO_TYPEMASK) {
|
||||||
case CURLINFO_STRING: {
|
case CURLINFO_STRING: {
|
||||||
char * value = (char *)SvPV(ST(2), PL_na);
|
char * value = (char *)SvPV(ST(2), PL_na);
|
||||||
@ -282,8 +747,7 @@ curl_easy_cleanup(curl)
|
|||||||
void * curl
|
void * curl
|
||||||
CODE:
|
CODE:
|
||||||
curl_easy_cleanup(curl);
|
curl_easy_cleanup(curl);
|
||||||
if (errbufvarname) free(errbufvarname);
|
init_globals();
|
||||||
errbufvarname = NULL;
|
|
||||||
RETVAL = 0;
|
RETVAL = 0;
|
||||||
OUTPUT:
|
OUTPUT:
|
||||||
RETVAL
|
RETVAL
|
||||||
|
@ -8,11 +8,14 @@
|
|||||||
|
|
||||||
# Change 1..1 below to 1..last_test_to_print .
|
# Change 1..1 below to 1..last_test_to_print .
|
||||||
# (It may become useful if the test is moved to ./t subdirectory.)
|
# (It may become useful if the test is moved to ./t subdirectory.)
|
||||||
|
use Benchmark;
|
||||||
|
use strict;
|
||||||
|
|
||||||
BEGIN { $| = 1; print "1..5\n"; }
|
BEGIN { $| = 1; print "1..13\n"; }
|
||||||
END {print "not ok 1\n" unless $loaded;}
|
END {print "not ok 1\n" unless $::loaded;}
|
||||||
use Curl::easy;
|
use Curl::easy;
|
||||||
$loaded = 1;
|
|
||||||
|
$::loaded = 1;
|
||||||
print "ok 1\n";
|
print "ok 1\n";
|
||||||
|
|
||||||
######################### End of black magic.
|
######################### End of black magic.
|
||||||
@ -21,81 +24,292 @@ print "ok 1\n";
|
|||||||
# (correspondingly "not ok 13") depending on the success of chunk 13
|
# (correspondingly "not ok 13") depending on the success of chunk 13
|
||||||
# of the test code):
|
# of the test code):
|
||||||
|
|
||||||
|
print "Testing curl version ",&Curl::easy::version(),"\n";
|
||||||
|
|
||||||
# Read URL to get
|
# Read URL to get
|
||||||
$defurl = "http://www/";
|
my $defurl = "http://localhost/cgi-bin/printenv";
|
||||||
$url = "";
|
my $url = "";
|
||||||
print "Please enter an URL to fetch [$defurl]: ";
|
print "Please enter an URL to fetch [$defurl]: ";
|
||||||
$url = <STDIN>;
|
$url = <STDIN>;
|
||||||
if ($url =~ /^\s*\n/) {
|
if ($url =~ /^\s*\n/) {
|
||||||
$url = $defurl;
|
$url = $defurl;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Use this for simple benchmarking
|
|
||||||
#for ($i=0; $i<1000; $i++) {
|
|
||||||
|
|
||||||
# Init the curl session
|
# Init the curl session
|
||||||
if (($curl = Curl::easy::curl_easy_init()) != 0) {
|
my $curl;
|
||||||
|
if (($curl = Curl::easy::init()) != 0) {
|
||||||
print "ok 2\n";
|
print "ok 2\n";
|
||||||
} else {
|
} else {
|
||||||
print "ko 2\n";
|
print "ko 2\n";
|
||||||
}
|
}
|
||||||
|
|
||||||
# Set URL to get
|
|
||||||
if (Curl::easy::curl_easy_setopt($curl, Curl::easy::CURLOPT_URL, $url) == 0) {
|
|
||||||
print "ok 3\n";
|
|
||||||
} else {
|
|
||||||
print "ko 3\n";
|
|
||||||
}
|
|
||||||
|
|
||||||
# No progress meter please
|
# No progress meter please
|
||||||
Curl::easy::curl_easy_setopt($curl, Curl::easy::CURLOPT_NOPROGRESS, 1);
|
# !! Need this on for all tests, as once disabled, can't re-enable it...
|
||||||
|
#Curl::easy::setopt($curl, CURLOPT_NOPROGRESS, 1);
|
||||||
|
|
||||||
# Shut up completely
|
# Shut up completely
|
||||||
Curl::easy::curl_easy_setopt($curl, Curl::easy::CURLOPT_MUTE, 1);
|
Curl::easy::setopt($curl, CURLOPT_MUTE, 1);
|
||||||
|
|
||||||
# Follow location headers
|
# Follow location headers
|
||||||
Curl::easy::curl_easy_setopt($curl, Curl::easy::CURLOPT_FOLLOWLOCATION, 1);
|
Curl::easy::setopt($curl, CURLOPT_FOLLOWLOCATION, 1);
|
||||||
|
|
||||||
# Set timeout
|
# Set timeout
|
||||||
Curl::easy::curl_easy_setopt($curl, Curl::easy::CURLOPT_TIMEOUT, 30);
|
Curl::easy::setopt($curl, CURLOPT_TIMEOUT, 30);
|
||||||
|
|
||||||
# Set file where to read cookies from
|
# Set file where to read cookies from
|
||||||
Curl::easy::curl_easy_setopt($curl, Curl::easy::CURLOPT_COOKIEFILE, "cookies");
|
Curl::easy::setopt($curl, CURLOPT_COOKIEFILE, "cookies");
|
||||||
|
|
||||||
# Set file where to store the header
|
# Set file where to store the header
|
||||||
open HEAD, ">head.out";
|
open HEAD, ">head.out";
|
||||||
Curl::easy::curl_easy_setopt($curl, Curl::easy::CURLOPT_WRITEHEADER, HEAD);
|
Curl::easy::setopt($curl, CURLOPT_WRITEHEADER, *HEAD);
|
||||||
|
print "ok 3\n";
|
||||||
|
|
||||||
# Set file where to store the body
|
# Set file where to store the body
|
||||||
open BODY, ">body.out";
|
# Send body to stdout - test difference between FILE * and SV *
|
||||||
Curl::easy::curl_easy_setopt($curl, Curl::easy::CURLOPT_FILE, BODY);
|
#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
|
# Store error messages in variable $errbuf
|
||||||
# NOTE: The name of the variable is passed as a string!
|
# NOTE: The name of the variable is passed as a string!
|
||||||
# curl_easy_setopt() creates a perl variable with that name, and
|
# setopt() creates a perl variable with that name, and
|
||||||
# curl_easy_perform() stores the errormessage into it if an error occurs.
|
# perform() stores the errormessage into it if an error occurs.
|
||||||
Curl::easy::curl_easy_setopt($curl, Curl::easy::CURLOPT_ERRORBUFFER, "errbuf");
|
|
||||||
|
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
|
# Go get it
|
||||||
if (Curl::easy::curl_easy_perform($curl) == 0) {
|
if (Curl::easy::perform($curl) == 0) {
|
||||||
Curl::easy::curl_easy_getinfo($curl, Curl::easy::CURLINFO_SIZE_DOWNLOAD, $bytes);
|
Curl::easy::getinfo($curl, CURLINFO_SIZE_DOWNLOAD, $bytes);
|
||||||
print "ok 4: $bytes bytes read\n";
|
print "ok 6: $bytes bytes read\n";
|
||||||
print "check out the files head.out and body.out\n";
|
Curl::easy::getinfo($curl, CURLINFO_EFFECTIVE_URL, $realurl);
|
||||||
print "for the headers and content of the URL you just fetched...\n";
|
Curl::easy::getinfo($curl, CURLINFO_HTTP_CODE, $httpcode);
|
||||||
Curl::easy::curl_easy_getinfo($curl, Curl::easy::CURLINFO_EFFECTIVE_URL, $realurl);
|
|
||||||
Curl::easy::curl_easy_getinfo($curl, Curl::easy::CURLINFO_HTTP_CODE, $httpcode);
|
|
||||||
print "effective fetched url (http code: $httpcode) was: $url\n";
|
print "effective fetched url (http code: $httpcode) was: $url\n";
|
||||||
} else {
|
} else {
|
||||||
# We can acces the error message in $errbuf here
|
# We can acces the error message in $errbuf here
|
||||||
print "ko 4: '$errbuf'\n";
|
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 = <STDIN>;
|
||||||
|
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 = <STDIN>;
|
||||||
|
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 = <STDIN>;
|
||||||
|
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
|
# Cleanup
|
||||||
close HEAD;
|
Curl::easy::cleanup($curl);
|
||||||
close BODY;
|
print "ok 21\n";
|
||||||
Curl::easy::curl_easy_cleanup($curl);
|
|
||||||
print "ok 5\n";
|
|
||||||
|
|
||||||
# Use this for simple benchmarking
|
|
||||||
#}
|
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user