From mmommer at common-lisp.net  Wed Aug 17 07:56:22 2005
From: mmommer at common-lisp.net (Mario S. Mommer)
Date: Wed, 17 Aug 2005 09:56:22 +0200
Subject: [cl-curl-devel] test
Message-ID: <87ll31ngih.fsf@darkstar.example.net>


just to see if this mailing list is working properly.

Regards,
        Mario.


From cl at healy.washington.dc.us  Tue Aug 30 02:22:03 2005
From: cl at healy.washington.dc.us (Liam M. Healy)
Date: Mon, 29 Aug 2005 22:22:03 -0400
Subject: [cl-curl-devel] Addings Outgoing headers for http
In-Reply-To: <431285E5.1090602@pb.co.za>
References: <42F6FD24.8090501@pb.co.za> <42F9065B.6040405@common-lisp.net>
	<17154.41598.440481.908469@zotz.local> <431285E5.1090602@pb.co.za>
Message-ID: <17171.49867.173635.379109@zotz.local>

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)