From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Sebastian Tennant Newsgroups: gmane.lisp.guile.user Subject: Re: Uploading Word documents, PDFs, PNG files etc Date: Thu, 21 May 2009 05:22:15 +0000 Message-ID: References: <87vdo7au56.fsf@ambire.localdomain> <87vdo5qc52.fsf@gnu.org> <7i0kzuog.fsf@vps203.linuxvps.org> <3ae3aa420905131223i3c7b83b0tf5a6ec9b200a8704@mail.gmail.com> <200905140347.n4E3l6LB003384@fcs13.keithdiane.us> <87ljove6oa.fsf@gnu.org> <7i0dbsvm.fsf@vps203.linuxvps.org> <87skj1il9s.fsf@gnu.org> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1242883392 17659 80.91.229.12 (21 May 2009 05:23:12 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Thu, 21 May 2009 05:23:12 +0000 (UTC) To: guile-user@gnu.org Original-X-From: guile-user-bounces+guile-user=m.gmane.org@gnu.org Thu May 21 07:23:05 2009 Return-path: Envelope-to: guile-user@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.50) id 1M70kB-0000rt-UM for guile-user@m.gmane.org; Thu, 21 May 2009 07:23:04 +0200 Original-Received: from localhost ([127.0.0.1]:37998 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1M70kA-0004d1-LF for guile-user@m.gmane.org; Thu, 21 May 2009 01:23:02 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1M70jf-0004cu-8B for guile-user@gnu.org; Thu, 21 May 2009 01:22:31 -0400 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1M70jZ-0004cM-IH for guile-user@gnu.org; Thu, 21 May 2009 01:22:30 -0400 Original-Received: from [199.232.76.173] (port=50644 helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1M70jZ-0004cG-9g for guile-user@gnu.org; Thu, 21 May 2009 01:22:25 -0400 Original-Received: from main.gmane.org ([80.91.229.2]:58408 helo=ciao.gmane.org) by monty-python.gnu.org with esmtps (TLS-1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.60) (envelope-from ) id 1M70jY-0006sn-Nb for guile-user@gnu.org; Thu, 21 May 2009 01:22:25 -0400 Original-Received: from list by ciao.gmane.org with local (Exim 4.43) id 1M70jV-0004Lo-AS for guile-user@gnu.org; Thu, 21 May 2009 05:22:21 +0000 Original-Received: from vps203.linuxvps.org ([91.186.7.203]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Thu, 21 May 2009 05:22:21 +0000 Original-Received: from sebyte by vps203.linuxvps.org with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Thu, 21 May 2009 05:22:21 +0000 X-Injected-Via-Gmane: http://gmane.org/ Original-Lines: 139 Original-X-Complaints-To: usenet@ger.gmane.org X-Gmane-NNTP-Posting-Host: vps203.linuxvps.org X-Composed-In: Gnus User-Agent: Gnus/5.110011 (No Gnus v0.11) Emacs/22.2 (gnu/linux) Cancel-Lock: sha1:FoggwGcDphzCAwQ/j264Vu9wqzY= X-detected-operating-system: by monty-python.gnu.org: GNU/Linux 2.6, seldom 2.4 (older, 4) X-BeenThere: guile-user@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: General Guile related discussions List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: guile-user-bounces+guile-user=m.gmane.org@gnu.org Errors-To: guile-user-bounces+guile-user=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.user:7314 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: 8bit Quoth ludo@gnu.org (Ludovic Courtès): > Hello, > > Sebastian Tennant writes: > >> Content-Disposition is mandatory, but Content-Type is optional >> (defaulting to text/plain) as is Content-Transfer-Encoding, so the >> "header part" of any given MIME part may be a single line or it may be >> three. > > Then I presume this could be read line-by-line as strings (using > `read-line' from `(ice-9 rdelim)') until the end-of-header marker is > reached. The remaining data would be read using `uniform-vector-read!' > or some such. Problem solved. With this patch applied to cgi.scm in ttn's (www cgi) module, uploading of binary data now works with Guile 1.8. In the end it was simply a case of splitting each part into a header section and value section using string-contains and substring rather than match:prefix and match:suffix. Thanks for all your help. Seb -- Emacs' AlsaPlayer - Music Without Jolts Lightweight, full-featured and mindful of your idyllic happiness. http://home.gna.org/eap --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=cgi.diff Content-Description: Unified diff --- cgi.scm 2007-10-04 10:35:38.000000000 +0000 +++ cgi-patched.scm 2009-05-21 04:48:58.210914642 +0000 @@ -212,10 +212,9 @@ (#:raw-mime-headers . ,raw-headers))) (set! u (updated-alist u name value))) - (let ((name-exp (make-regexp "name=\"([^\"]*)\"")) - (filename-exp (make-regexp "filename=\"*([^\"\r]*)\"*")) - (type-exp (make-regexp "Content-Type: ([^\r]*)\r\n" regexp/icase)) - (value-exp (make-regexp "\r\n\r\n"))) + (let ((name-rx (make-regexp "name=\"([^\"]*)\"")) + (filename-rx (make-regexp "filename=\"*([^\"\r]*)\"*")) + (type-rx (make-regexp "Content-Type: ([^\r]*)$" regexp/icase))) (let level ((str raw-data) (boundary (determine-boundary (env-look 'content-type))) @@ -233,41 +232,56 @@ (lambda (seg-finish) (cons (subs str seg-start (- seg-finish 2)) seg-finish)))))) + ;; segment-newstart is a cons of the form + ;; ("\r\n\r\n\r\n" + ;; . + ;; ) (lambda (segment-newstart) (let* ((segment (car segment-newstart)) - (try (lambda (rx extract) - (and=> (regexp-exec rx segment) - extract))) - (name (or parent-name - (try name-exp m1))) - (value (try value-exp match:suffix)) - (type (try type-exp m1))) - (and name + ;; segment splitter + (seg-split + (lambda (pattern string portion) + (and=> (string-contains string pattern) portion))) + ;; split segment into header(s) and value + (headers (seg-split "\r\n\r\n" segment + (lambda (index) + (substring segment 2 index)))) + (value (seg-split "\r\n\r\n" segment + (lambda (index) + (substring segment (+ index 4))))) + ;; extract data from header(s) + (hdr-extract (lambda (rx extract) + (and=> (regexp-exec rx headers) + extract))) + (name (or parent-name (hdr-extract name-rx m1))) + (type (hdr-extract type-rx m1)) + (filename (hdr-extract filename-rx m1))) + + (and name value - (cond ((and type - (not parent-name) ; only recurse once - (string-match "multipart/mixed" type)) - (level value - (determine-boundary type) - name)) - ((and type (try filename-exp m1)) - => (lambda (filename) - (stash-file-upload! - name filename type value - (subs (try value-exp match:prefix) - 2)))) - (else - (stash-form-variable! name value))))) + (cond ((and type + (not parent-name) ; only recurse once + (string-match "multipart/mixed" type)) + (level value + (determine-boundary type) + name)) + ((and type (hdr-extract filename-rx m1)) + => (lambda (filename) + (stash-file-upload! + name filename type value headers))) + (else + (stash-form-variable! name value))) + )) (get-pair (cdr segment-newstart)))))))) (cons (reverse! v) (reverse! u)))) (define (get-cookies raw) ;; Parse RAW (a string) for cookie-like frags. Return an alist. - (let ((pair-exp (make-regexp "([^=; \t\n]+)=([^=; \t\n]+)")) + (let ((pair-rx (make-regexp "([^=; \t\n]+)=([^=; \t\n]+)")) (c (list))) (define (get-pair str) - (let ((pair-match (regexp-exec pair-exp str))) + (let ((pair-match (regexp-exec pair-rx str))) (if (not pair-match) '() (let ((name (match:substring pair-match 1)) (value (match:substring pair-match 2))) --=-=-=--