[cl-curl-devel] Addings Outgoing headers for http
Liam M. Healy
cl at healy.washington.dc.us
Tue Aug 30 02:22:03 UTC 2005
Pieter,
Thank you for your contribution.
I wonder if there's a better way to handle the HTTPHEADERS than to put
a setopt into perform. I'm thinking it would be better to leave
perform as a pure perform. Maybe we can make a function to finalize
the headers, or is that too much overhead?
Also, I'm a little confused about the files you attached. You
attached curl.asd which seems unchanged from the (old) version of that
file, but not curl.lisp, which you imply in your message that you
changed. Could you resend all changed files, preferably based on the
current SVN version?
Thanks again.
Liam
>>>>> "Pieter" == Pieter Breed <pieter at pb.co.za> writes:
Pieter> Hi Liam,
Pieter> I really am sorry that I took so long to respond. I wanted to try the
Pieter> modifications that I made out in an application before just submitting
Pieter> the code.
Pieter> The issue was this: I debated with myself whether it will be more or
Pieter> less useful to require that you 1) set all the HTTPHEADERs at once using
Pieter> a call such as
Pieter> (curl:set-option :httpheader '("string1" "string2" ...))
Pieter> or 2) you should be allowed to set subsequent httpheaders with
Pieter> subsequent calls the set-option, like this:
Pieter> (curl:set-option :httpheader "string1")
Pieter> (curl:set-option :httpheader "string2")
Pieter> ...
Pieter> After using the library I decided that the latter method is most clear,
Pieter> but maybe not as lispy as one would like. Obviously, the fact that the
Pieter> lib-curl library is not written in lisp itself, might have something to
Pieter> do with this.
Pieter> Anyway, the change is made to the CurlTransaction structure, by adding a
Pieter> struct curl_slist *HTTPHEADERS_slist;
Pieter> line to it. Then just make sure that init and cleanup code works, and a
Pieter> function or two to enable adding information to this struct. On the lisp
Pieter> side, I put in a special check on the curl:set-option method to check
Pieter> whether the option being set is :httpheader or not, and then handling it
Pieter> with the dedicated defun if it is, or with the defaults if it is not.
Pieter> Friendly Regards,
Pieter> Pieter Breed
Pieter> Liam M. Healy wrote:
>> Pieter,
>>
>> Thanks for your contribution.
>>
>> I'm not at all familiar with the HTTPHEADER issue but if you have
>> something that works, and it doesn't adversely affect anything else, I
>> will include it. I don't think there's any problem with attachments;
>> can you please send me the output of diff and I will apply patch to
>> regenerate your original files. Alternatively, you can just attach
>> the files you changed.
>>
>> Sorry for the delay in response, I was out of town and off the net for
>> a week.
>>
>> Liam
>>
>>
>>
>>>>>>> "Pieter" == Pieter Breed <cl-curl-devel at common-lisp.net> writes:
>>
>>
Pieter> I dove in and did (some of) the work myself. I made some slight
Pieter> modifications to both the glue code and to the lisp code.
>>
Pieter> The modifications enable the following lisp code,
>>
Pieter> (curl:with-connection-returning-string (:cookies nil)
Pieter> (curl:set-option :url "http://localhost/")
Pieter> (curl:set-option :httpheader "pieter: test")
Pieter> (curl:set-option :httpheader "pieter2: test2")
Pieter> (curl:set-option :header t)
Pieter> (curl:perform))
>>
Pieter> with the following index.php running on my home apache,
>>
Pieter> 1 <?
Pieter> 2
Pieter> 3 $headers = apache_request_headers();
Pieter> 4
Pieter> 5 foreach( $headers as $name => $val ) {
Pieter> 6 print "$name: $val<br>";
Pieter> 7 }
Pieter> 8
>>
Pieter> to produce the following output:
>>
>>
Pieter> "HTTP/1.1 200 OK
Pieter> Date: Tue, 09 Aug 2005 19:26:41 GMT
Pieter> Server: Apache/2.0.53 (Ubuntu) mod_lisp2/1.2 PHP/4.3.10-10ubuntu4
Pieter> X-Powered-By: PHP/4.3.10-10ubuntu4
Pieter> Content-Length: 88
Pieter> Content-Type: text/html
>>
Pieter> Host: localhost<br>Pragma: no-cache<br>Accept: */*<br>pieter:
Pieter> test<br>pieter2: test2<br>"
>>
Pieter> Since I am not sure if I may add attachments, I will copy the full text
Pieter> of curl.c and the extra and modified parts of curl.lisp below:
>>
Pieter> Friendly Regards,
Pieter> Pieter Breed
>> _______________________________________________
>> cl-curl-devel mailing list
>> cl-curl-devel at common-lisp.net
>> http://common-lisp.net/cgi-bin/mailman/listinfo/cl-curl-devel
>>
>>
Pieter> /* ******************************************************** */
Pieter> /* file: curl.c */
Pieter> /* description: Glue functions for CL interface to */
Pieter> /* libcurl. */
Pieter> /* date: Thu Jan 20 2005 - 15:26 */
Pieter> /* author: Liam M. Healy <cl at healy.washington.dc.us> */
Pieter> /* modified: Sat Feb 5 2005 - 12:48 */
Pieter> /* ******************************************************** */
Pieter> /* To make a library:
Pieter> gcc -fPIC -shared curl.c -lcurl -Wl,-soname,libclcurl.so -o libclcurl.so
Pieter> */
Pieter> #include <stdio.h>
Pieter> #include <curl/curl.h>
Pieter> struct MemoryStruct {
Pieter> char *memory;
Pieter> size_t size;
Pieter> };
Pieter> struct CurlTransaction {
Pieter> struct MemoryStruct chunk;
Pieter> struct curl_slist *HTTPHEADERS_slist;
Pieter> CURL *handle;
Pieter> };
Pieter> /* Taken from /usr/share/doc/libcurl2-dev/examples/getinmemory.c */
Pieter> size_t
Pieter> WriteMemoryCallback(void *ptr, size_t size, size_t nmemb, void *data)
Pieter> {
Pieter> register int realsize = size * nmemb;
Pieter> struct MemoryStruct *mem = (struct MemoryStruct *)data;
mem-> memory = (char *)(long)realloc(mem->memory, mem->size + realsize + 1);
Pieter> if (mem->memory) {
Pieter> memcpy(&(mem->memory[mem->size]), ptr, realsize);
mem-> size += realsize;
mem-> memory[mem->size] = 0;
Pieter> }
Pieter> return realsize;
Pieter> }
Pieter> struct CurlTransaction *curl_init_write_string()
Pieter> {
Pieter> struct CurlTransaction *curltran;
Pieter> curltran = (struct CurlTransaction *)(long)malloc(sizeof(struct CurlTransaction));
Pieter> if (curltran != NULL) {
curltran-> HTTPHEADERS_slist = NULL; /* initialise the empty list for custom outgoing HTTP HEADERS */
curltran-> chunk.memory=NULL; /* we expect realloc(NULL, size) to work */
curltran-> chunk.size = 0; /* no data at this point */
curltran-> handle = curl_easy_init();
Pieter> if (curltran->handle) {
Pieter> /* send all data to this function */
Pieter> curl_easy_setopt(curltran->handle, CURLOPT_WRITEFUNCTION, WriteMemoryCallback);
Pieter> /* we pass our 'chunk' struct to the callback function */
Pieter> curl_easy_setopt(curltran->handle, CURLOPT_WRITEDATA, (void *)&curltran->chunk);
Pieter> return curltran;
Pieter> }
Pieter> return (struct CurlTransaction *)NULL;
Pieter> }
Pieter> return (struct CurlTransaction *)NULL;
Pieter> }
Pieter> size_t
Pieter> ReadMemoryCallback(void *ptr, size_t size, size_t nmemb, void *data)
Pieter> {
Pieter> size_t length = size*nmemb;
Pieter> strncpy(ptr,data,length);
Pieter> return length;
Pieter> }
Pieter> int curl_set_read_string(struct CurlTransaction *curltran, char *string)
Pieter> /* Set a string to read from */
Pieter> {
Pieter> curl_easy_setopt(curltran->handle, CURLOPT_READFUNCTION, ReadMemoryCallback);
Pieter> curl_easy_setopt(curltran->handle, CURLOPT_READDATA, string);
Pieter> return 0;
Pieter> }
Pieter> int curl_set_option_string(struct CurlTransaction *curltran, int option, char *val)
Pieter> {
Pieter> if (curltran->handle) {
Pieter> return curl_easy_setopt(curltran->handle, option, val);
Pieter> } else {
Pieter> return -1;
Pieter> }
Pieter> }
Pieter> int curl_set_option_httpheaders_string(struct CurlTransaction *curltran, char *val)
Pieter> {
Pieter> if (curltran->handle) {
curltran-> HTTPHEADERS_slist = curl_slist_append( curltran->HTTPHEADERS_slist, val );
Pieter> if ( curltran->HTTPHEADERS_slist == NULL ) {
Pieter> return 2;
Pieter> } else {
Pieter> return 0;
Pieter> }
Pieter> } else {
Pieter> return -1;
Pieter> }
Pieter> }
Pieter> int curl_set_option_long(struct CurlTransaction *curltran, int option, long val)
Pieter> {
Pieter> if (curltran->handle) {
Pieter> return curl_easy_setopt(curltran->handle, option, val);
Pieter> } else {
Pieter> return -1;
Pieter> }
Pieter> }
Pieter> int curl_get_information_string(struct CurlTransaction *curltran, int option, char *val)
Pieter> {
Pieter> if (curltran->handle) {
Pieter> return curl_easy_getinfo(curltran->handle, option, val);
Pieter> } else {
Pieter> return -1;
Pieter> }
Pieter> }
Pieter> int curl_get_information_long(struct CurlTransaction *curltran, int option, long *val)
Pieter> {
Pieter> if (curltran->handle) {
Pieter> return curl_easy_getinfo(curltran->handle, option, val);
Pieter> } else {
Pieter> return -1;
Pieter> }
Pieter> }
Pieter> int curl_get_information_double(struct CurlTransaction *curltran, int option, double *val)
Pieter> {
Pieter> if (curltran->handle) {
Pieter> return curl_easy_getinfo(curltran->handle, option, val);
Pieter> } else {
Pieter> return -1;
Pieter> }
Pieter> }
Pieter> int curl_perform(struct CurlTransaction *curltran)
Pieter> {
Pieter> /* We must first check if custom outgoing headers were
Pieter> specified and set them if it is the case
Pieter> */
Pieter> if ( curltran->HTTPHEADERS_slist != NULL ) {
Pieter> curl_easy_setopt( curltran->handle, CURLOPT_HTTPHEADER, curltran->HTTPHEADERS_slist );
Pieter> }
Pieter> return curl_easy_perform(curltran->handle);
Pieter> }
Pieter> char *curl_return_string(struct CurlTransaction *curltran)
Pieter> {
Pieter> return curltran->chunk.memory;
Pieter> }
Pieter> void curl_free_string(struct CurlTransaction *curltran)
Pieter> {
Pieter> free(curltran->chunk.memory);
Pieter> }
Pieter> void curl_finish(struct CurlTransaction *curltran)
Pieter> {
Pieter> if ( curltran->HTTPHEADERS_slist != NULL ) {
Pieter> curl_slist_free_all( curltran->HTTPHEADERS_slist );
Pieter> }
Pieter> curl_easy_cleanup(curltran->handle);
Pieter> free(curltran);
Pieter> }
Pieter> ;;; -*- Lisp -*-
Pieter> ;********************************************************
Pieter> ; file: curl.asd
Pieter> ; description: System definition for curl.
Pieter> ; date: Sun Mar 6 2005 - 10:29
Pieter> ; author: Liam M. Healy <cl at healy.washington.dc.us>
Pieter> ; modified: Sun Mar 6 2005 - 10:29
Pieter> ;********************************************************
Pieter> (eval-when (:compile-toplevel :load-toplevel :execute)
Pieter> (asdf:operate 'asdf:load-op :uffi)
Pieter> ;; (clc:clc-require :uffi)
Pieter> )
Pieter> (defpackage #:curl (:use cl asdf))
Pieter> (in-package #:curl)
Pieter> ;;; we also have a shared library with some .o files in it
Pieter> (format t "~&starting")
Pieter> (defclass unix-dso (module) ())
Pieter> (defun unix-name (pathname)
Pieter> (namestring
Pieter> (typecase pathname
Pieter> (logical-pathname (translate-logical-pathname pathname))
Pieter> (t pathname))))
Pieter> (defmethod asdf::input-files ((operation compile-op) (dso unix-dso))
Pieter> (mapcar #'component-pathname (module-components dso)))
Pieter> (defmethod output-files ((operation compile-op) (dso unix-dso))
Pieter> (let ((dir (component-pathname dso)))
Pieter> (list
Pieter> (make-pathname :type "so"
Pieter> :name (car (last (pathname-directory dir)))
Pieter> :directory (butlast (pathname-directory dir))
Pieter> :defaults dir))))
Pieter> (defmethod perform :after ((operation compile-op) (dso unix-dso))
Pieter> (let ((dso-name (unix-name (car (output-files operation dso)))))
Pieter> (unless (zerop
Pieter> (run-shell-command
Pieter> "gcc ~A -o ~S ~{~S ~}"
Pieter> #-x86-64
Pieter> "-fPIC -shared -lcurl"
Pieter> #+x86-64
Pieter> ;; For some reason, SBCL x86-64 gets a segmentation violation
Pieter> ;; unless compiled -g
Pieter> "-g -fPIC -shared -lcurl"
Pieter> dso-name
Pieter> (mapcar #'unix-name
Pieter> (mapcan (lambda (c)
Pieter> (output-files operation c))
Pieter> (module-components dso)))))
Pieter> (error 'operation-error :operation operation :component dso))))
Pieter> ;;; if this goes into the standard asdf, it could reasonably be extended
Pieter> ;;; to allow cflags to be set somehow
Pieter> (defmethod output-files ((op compile-op) (c c-source-file))
Pieter> (list
Pieter> (make-pathname :type "o" :defaults
Pieter> (component-pathname c))))
Pieter> (defmethod perform ((op compile-op) (c c-source-file))
Pieter> (unless
Pieter> (= 0 (run-shell-command "gcc ~A -o ~S -c ~S"
Pieter> "-fPIC -shared -lcurl"
Pieter> (unix-name (car (output-files op c)))
Pieter> (unix-name (component-pathname c))))
Pieter> (error 'operation-error :operation op :component c)))
Pieter> (defmethod perform ((operation load-op) (c c-source-file))
Pieter> t)
Pieter> ;;; Load the .so library
Pieter> (defmethod perform ((o load-op) (c unix-dso))
Pieter> (let ((co (make-instance 'compile-op)))
Pieter> (let ((filename (car (output-files co c))))
Pieter> (uffi:load-foreign-library filename))))
Pieter> (defsystem curl
Pieter> :version "0.10"
Pieter> :depends-on (uffi)
Pieter> :components
Pieter> ((:unix-dso "clcurl"
Pieter> :components ((:c-source-file "curl")))
Pieter> (:file "curl" :depends-on ("clcurl"))))
Pieter> (defmethod perform :after ((o load-op) (c (eql (find-system :curl))))
Pieter> (provide 'curl))
Pieter> (defmethod perform ((o test-op) (c (eql (find-system :curl))))
Pieter> (operate 'load-op 'curl)
Pieter> (operate 'test-op 'curl))
Pieter> (unuse-package :asdf)
More information about the Cl-curl-devel
mailing list