Cris Bailiff's and Georg Horn's big improvements (ebcafe73) · Commits · CYBER - Cyber Security / TS 103 523 MSP / TLMSP / TLMSP curl

perl/Curl_easy/Changes

+34 −0

Original line number	Original line	Diff line number	Diff line
	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

perl/Curl_easy/Makefile.PL

+1 −1

Original line number	Original line	Diff line number	Diff line
	@@ -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"}
	);		);

perl/Curl_easy/easy.pm

+120 −10

Original line number	Original line	Diff line number	Diff line
	@@ -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/

perl/Curl_easy/easy.xs

+483 −19

Original line number	Original line	Diff line number	Diff line
	@@ -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) {
			case CURLOPT_WRITEFUNCTION:
			register_callback(&write_callback, value);
			curl_easy_setopt(curl, CURLOPT_WRITEFUNCTION, write_callback_func);
			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;		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 = &quote; 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 {		} else {
	/* default, option specifying a char * value: */		internal_options &= !option;
	RETVAL = curl_easy_setopt(curl, option, value);
	}		}
			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

perl/Curl_easy/test.pl

+255 −41

File changed.

Preview size limit exceeded, changes collapsed.