Re: CGI scripting with Guile

[Thien-Thi Nguyen <ttn@gnuvola.org>]

() Sebastian Tennant <sebyte@smolny.plus.com>
() Sun, 16 Mar 2008 00:10:11 +0200

    #!/usr/bin/guile -s
    !#
   works.

    #!/usr/bin/guile -s
    !#
    (use-modules (www cgi))
   doesn't.

   Why doesn't the second script work?

What does the client see for the second case?  I think both cases
are malformed; IIRC, HTTP header lines need to end in CRLF, not just
LF.  The empty line between header and body should likewise be CRLF.
Also, you need to call `cgi:init'.  Appended is examples/id.cgi.in
(you will need to do the @VAR@ substitutions manually and remove the
`load-from-path' calls) from the Guile-WWW 2.21 distribution, for
example.

   The additional line works in a
   guile process running on the server.

Maybe the server is lucky; some systems are (sometimes) slackful.

thi

____________________________________________________________________
#!/bin/sh
exec @GUILE@ -s $0 "$@" # -*- scheme -*-
!#
;;; id.cgi --- the "hello world" of CGI scripts

;;	Copyright (C) 2005 Free Software Foundation, Inc.
;;
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this software; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA  02110-1301  USA

;;; Commentary:

;; This CGI script displays the environment
;; discernable by module (www cgi).

;;; Code:

;; Load the module.  Normally, these explicit loads can be omitted --
;; we use it to help the perpetually confused Guile module system DTRT.

(load-from-path "@abs_top_builddir@/url-coding.scm")
(load-from-path "@abs_top_builddir@/cgi.scm")
(use-modules (www cgi))

;; Abstractions: formatted string output, sectioned output, collection.

(define (fso s . args)
  (apply simple-format #t s args))

(define-macro (section title . body)
  `(begin
     (fso "\nSECTION: ~A\n" ,title)
     ,@body
     (newline)))

(define (collect look save)
  (let loop ((acc '()) (names (cgi:names)))
    (if (null? names)
        (reverse! acc)                  ; rv
        (loop (cond ((look (car names))
                     => (lambda (x) (cons (save (car names) x) acc)))
                    (else acc))
              (cdr names)))))

;; Initialize the context.  For fastcgi environments, this should be
;; called each time to reinitialize the context, and the rest of the
;; file converted from multiple top-level forms into a thunk.

(cgi:init)

;; Output the headers.  Each header is followed by a CRLF pair, and the
;; headers are separated from the body by another CRLF.  In this case,
;; we have only one header.

(fso "Content-Type: text/plain\r\n\r\n")

;; Output the body.

(fso "=== Output from ~S (@PACKAGE_NAME@ @PACKAGE_VERSION@) ===\n"
     (command-line))

(section
 "Environment Variables (using `cgi:getenv')"
 (for-each (lambda (var)
             (fso "\n~A:\n~S\n" var (cgi:getenv var)))
           '(server-hostname
             gateway-interface
             server-port
             request-method
             path-info
             path-translated
             script-name
             query-string
             remote-host
             remote-addr
             authentication-type
             remote-user
             remote-ident
             content-type
             content-length
             http-user-agent
             http-cookie
             server-software-type
             server-software-version
             server-protocol-name
             server-protocol-version
             http-accept-types)))

(section
 "Form Data (using `cgi:form-data?', `cgi:names' and `cgi:values')"
 (if (cgi:form-data?)
     (let ((ls (cgi:names)))
       (fso "(~A names)\n" (length ls))
       (for-each (lambda (name)
                   (fso "\n~A:\n~S\n" name (cgi:values name)))
                 ls))
     (fso "(none)\n")))

(section
 "File Uploads (using `cgi:uploads')"
 (let* ((ls (append! (collect cgi:uploads (lambda (name u) u))))
        (tot (length ls)))
   (cond ((= 0 tot)
          (fso "(none)\n"))
         (else
          (fso "(~A uploads)\n" tot)
          (for-each (lambda (u)
                      (let* ((minfo (object-property u #:guile-www-cgi))
                             (m (lambda (part) (assq-ref minfo part))))
                        (fso "\n~A: ~A (~A, ~A bytes)\n~A\n"
                             (m #:name)
                             (m #:filename)
                             (m #:mime-type)
                             (string-length u)
                             (m #:raw-mime-headers))))
                    ls)))))

(section
 "Cookies (using `cgi:cookies')"
 (let* ((ls (collect cgi:cookies cons))
        (tot (apply + (map length (map cdr ls)))))
   (cond ((= 0 tot)
          (fso "(none)\n"))
         (else
          (fso "(~A cookies)\n" tot)
          (for-each (lambda (name/c)
                      (fso "\n~A: ~A\n" (car name/c) (length (cdr name/c)))
                      (for-each (lambda (c)
                                  (fso " ~A\n" c))
                                (cdr name/c)))
                    ls)))))

;;; id.cgi ends here