cl-curl-devel

Download

cl-curl-devel@common-lisp.net

August 2005

2 participants
2 discussions

Re: [cl-curl-devel] Addings Outgoing headers for http
by Liam M. Healy 30 Aug '05

30 Aug '05

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(a)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(a)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 "; 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 Pragma: no-cache Accept: */* pieter: Pieter> test pieter2: test2 " >> 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(a)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(a)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(a)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)

1 0

[cl-curl-devel] test
by mmommer＠common-lisp.net 17 Aug '05

17 Aug '05

just to see if this mailing list is working properly. Regards, Mario.

1 0