* Re: Guile & Sablotron
2004-03-09 17:32 Guile & Sablotron Brian S McQueen
@ 2004-03-12 8:52 ` Thien-Thi Nguyen
2004-03-14 9:09 ` XML, HTML and Scheme (was: Guile & Sablotron) Daniel Skarda
` (2 subsequent siblings)
3 siblings, 0 replies; 6+ messages in thread
From: Thien-Thi Nguyen @ 2004-03-12 8:52 UTC (permalink / raw)
Cc: guile-user
[-- Attachment #1: Type: text/plain, Size: 1193 bytes --]
From: Brian S McQueen <bqueen@nas.nasa.gov>
Date: Tue, 9 Mar 2004 09:32:05 -0800 (PST)
Using a template engine is the way to go for handling the
presentation of data.
i surmise from skimming the axkit homepage that the axkit concept
of "template" is not only the traditional "fill this named space w/
customized bits", but possibly time-varying as well (results are
not fully finalized; tags are kept around; caching is selective).
that's a fine approach to flattening the tree. however, i'm less
than enamored w/ the xml representation, despite its merits.
btw, thanks for your good question on "adding to a list". it
helped spur recent(ish) development of some (www server-utils *)
modules. you can find a work-in-progress (but working nonetheless)
webserver that uses these modules, attached. the first file is the
webserver proper. the second one contains servlets (callbacks for
dynamic content creation). it is left as an exercise for the
reader to write a servlet that uses (database postgres*) modules to
make queries, retrieve scheme objects, and send them over the wire.
axkit-like caching is likewise a SMOP.
thi
_____________________________________________
[-- Attachment #2: mgrabmue-webserver.scm --]
[-- Type: application/octet-stream, Size: 8820 bytes --]
#! /bin/sh
GUILE=/tmp/a/b/c/bin/guile ; export GUILE
exec ${GUILE-guile} -e "(ttn-do mgrabmue-webserver)" -s $0 "$@"
!#
;;; ID: $Id$
;;; Copyright (C) 2004 Thien-Thi Nguyen
;;; Copyright (C) 2000, 2001 Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
;;; This program is part of ttn-do, released under GNU GPL v2 with ABSOLUTELY
;;; NO WARRANTY. See http://www.gnu.org/copyleft/gpl.txt for details.
;;;
;;; Description: Simple web server.
;;; Commentary:
;; Usage: mgrabmue-webserver -r DIR [options...]
;; -p, --port=PORT -- Listen on PORT (default: 8001)
;; -r, --docroot=DIR -- Specify DIR as filesystem root (required)
;; -u, --ulibdir=DIR -- Look in DIR for mgrabmue-servlets.scm
;;; Code:
(define-module (ttn-do mgrabmue-webserver)
#:use-module (scripts PROGRAM)
#:use-module (scripts slurp)
#:use-module (ice-9 regex)
#:use-module (www server-utils big-dishing-loop)
#:use-module (www server-utils filesystem)
#:use-module (www server-utils log)
#:use-module (www data http-status)
#:use-module (www data content-type))
(define *server-name* "SizzWeb 0.0.3")
(define no-access? #f) ; set by main/qop
(define fs-name #f)
\f
;; Standard responses ================================================
(define (add-standard-headers M)
(M #:add-header #:Date (strftime "%a, %m %b %Y %H:%M:%S GMT"
(gmtime (current-time))))
(M #:add-header #:Server *server-name*))
(define (*top+title title)
(list "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">"
"<HTML><HEAD><TITLE>" title "</TITLE></HEAD><BODY>"))
(define (*bottom)
(list "<HR><ADDRESS>" *server-name* "</ADDRESS></BODY></HTML>"))
(define (send-error M number . body)
(let ((msg (assq-ref *http-status* number))
(nstr (number->string number)))
(M #:set-reply-status number msg)
(add-standard-headers M)
(M #:add-header #:Connection "close")
(M #:add-header #:Content-Type "text/html")
(M #:add-content
(*top+title (list nstr " " msg))
"<H2>" nstr " " msg "</H2>"
body
(*bottom))
(M #:rechunk-content #t)
(M #:send-reply)))
(define (send-not-found M upath)
(send-error M 404
"The requested URL:<BR><B>"
upath
"</B><BR>was not found on this server."))
(define (send-bad-request M)
(send-error M 400
"Your browser sent a request that"
" this server could not understand."))
(define (send-unknown-method M method upath)
(send-error M 501
"<B>"
(symbol->string method)
"</B> to <B>"
upath
"</B> not supported."))
(define (send-forbidden M upath)
(send-error M 403
"You do not have permission to access:<BR><B>"
upath
"</B>"))
(define (send-moved-permanently M upath)
(send-error 301
"The document has been moved <A HREF=\""
upath
"\">here</A>"))
\f
;; Special responses =================================================
;; Construct and send a directory index.
;;
(define (send-generated-directory-index M upath dir)
(add-standard-headers M)
(M #:set-reply-status:success)
(M #:add-header #:Connection "close")
(M #:add-header #:Content-Type "text/html")
(let ((rev (reverse (string->list upath))))
(set! upath (list->string (reverse (if (char=? #\/ (car rev))
(cdr rev)
rev)))))
(M #:add-content
(*top+title (list "Directory " upath))
"<H2>Parent Directories</H2>"
(let loop ((start 0) (acc '()))
(cond ((string-index upath #\/ start)
=> (lambda (cut)
(set! cut (1+ cut))
(loop cut (acons start cut acc))))
(else
(map (lambda (x)
(list "<A HREF=\""
(substring upath 0 (cdr x))
"\">"
(substring upath (car x) (cdr x))
"</A><BR>"))
(reverse acc)))))
"<H2>Directory " (basename upath) "</H2><HR><PRE>"
(sort
(let ((dir-stream (opendir dir)))
(let loop ((file (readdir dir-stream)) (acc '()))
(if (eof-object? file)
(reverse acc)
(loop (readdir dir-stream)
(if (or (string=? "." file)
(string=? ".." file))
acc
(cons (format #f " <A HREF=~S>~A</A>\n"
(in-vicinity upath file) file)
acc))))))
string<?)
"</PRE>"
(*bottom))
(M #:rechunk-content (* 16 1024))
(M #:send-reply))
;; Transfer a file.
;;
(define (transmit-file M filename)
(add-standard-headers M)
(M #:set-reply-status:success)
(M #:add-header #:Connection "close")
(M #:add-header #:Content-Type (filename->content-type filename "text/plain"))
(M #:add-content (slurp filename))
(M #:rechunk-content (* 16 1024))
(M #:send-reply))
\f
;; Dynamic URLs ======================================================
;; This is the list of registered dynamic handlers. The car of the
;; association is a compiled regexp, the cdr the corresponding handler.
(define *dynamic-url-handlers* '())
(define (add-dynamic-handler! re-str handler)
(set! *dynamic-url-handlers*
(append! ; maintain order
*dynamic-url-handlers*
(acons (make-regexp re-str) handler '()))))
;; Return a dynamic handler suitable for `upath', or #f if non found.
;;
(define (find-dynamic-url-handler upath)
(let loop ((ls *dynamic-url-handlers*))
(cond ((null? ls) #f)
((regexp-exec (car (car ls)) upath) (cdr (car ls)))
(else (loop (cdr ls))))))
\f
;; Main program ======================================================
(define (make-server-loop no-access?)
(make-big-dishing-loop
#:need-headers #t
#:need-input-port #t
#:GET-upath (lambda (M upath headers in-port)
(M #:reset-protocol!)
(cond ((find-dynamic-url-handler upath)
=> (lambda (handle)
(handle M in-port upath headers)))
(else
(let ((filename (fs-name upath)))
(cond ((not filename)
(send-not-found M upath))
((no-access? filename)
(send-forbidden M upath))
((file-is-directory? filename)
(send-generated-directory-index
M upath filename))
(else
(transmit-file M filename))))
#t)))
#:status-box-size 2
#:bad-request-handler send-bad-request
#:unknown-http-method-handler send-unknown-method
#:log (log-http-response-proc (current-output-port))))
(define (main/qop qop)
(let ((docroot (qop 'docroot (lambda (dir) (in-vicinity dir ""))))
(listening-port (or (qop 'port string->number)
8001)))
(set! fs-name (upath->filename-proc
docroot '("index.shtml" "index.html")))
(qop 'ulibdir (lambda (dir)
(false-if-exception
(load (in-vicinity dir "mgrabmue-servlets.scm")))))
(format #t "Starting on port ~A, with docroot ~S.\n"
listening-port docroot)
((make-server-loop (access-forbidden?-proc
docroot (regexp-quote "/../")))
listening-port)
(format #t "Shutting down\n")
#t))
(define (main args)
(HVQC-MAIN args main/qop
'(usage . commentary)
'(version . "1.0")
(let ((valid-dir (lambda (file)
(define (bad msg)
(format #t "~A: ~A: ~A\n"
(car args) msg file)
#f)
(and (or (access? file R_OK)
(bad "cannot read"))
(or (file-is-directory? file)
(bad "not a directory"))))))
`(option-spec
(port (single-char #\p) (value #t))
(docroot (single-char #\r) (value #t) (required? #t)
(predicate ,valid-dir))
(ulibdir (single-char #\u) (value #t)
(predicate ,valid-dir))))))
;;; mgrabmue-webserver.scm ends here
[-- Attachment #3: mgrabmue-servlets.scm --]
[-- Type: application/octet-stream, Size: 5503 bytes --]
;;; mgrabmue-servlets.scm -- user servlets for the webserver
;;;
;;; Copyright (C) 2004 Thien-Thi Nguyen
;;; Copyright (C) 2000, 2001 Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
;;;
;;; This 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 2, or (at your option)
;;; any later version.
;;;
;;; This software 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 package; see the file COPYING. If not, write to
;;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; This file demonstrates how you can write your own customized servlet
;; in SizzWeb. A servlet procedure must perform the followin steps:
;; - Set the HTTP response status
;; - Add appropriate headers
;; - Add content
;; - Commit the response.
;;; Code:
(define-module (ttn-do mgrabmue-webserver)
#:use-module (ttn shell-command-to-string))
;; Kill the server loop (by returning #f).
;;
(add-dynamic-handler!
"^/qqq"
(lambda (M in-port upath headers)
(add-standard-headers M)
(M #:set-reply-status:success)
(M #:add-header #:Connection "close")
(M #:add-header #:Content-Type "text/plain")
(M #:add-content "bye!")
(M #:send-reply)
#f))
;; Write a short message and dump the headers from the client.
;;
(add-dynamic-handler!
"^/test"
(lambda (M in-port upath headers)
(add-standard-headers M)
(M #:set-reply-status:success)
(M #:add-header #:Connection "close")
(M #:add-header #:Content-Type "text/html")
(M #:add-content
"<HTML><HEAD><TITLE>It worked</TITLE></HEAD><BODY>"
"<P>It seems that dynamic URL support in " *server-name* " works.</P>"
"<P>The following headers were sent by your browser:</P><TABLE>"
(map (lambda (x)
(list "<TR><TD>" (car x) "</TD><TD>" (cdr x) "</TD></TR>\n"))
headers)
"</TABLE></BODY></HTML>")
(M #:send-reply)))
;; Register the time servlet to respond for all URLs below `/time'.
;;
(add-dynamic-handler!
"/time"
(lambda (M in-port upath headers)
(add-standard-headers M)
(M #:set-reply-status:success)
(M #:add-header #:Connection "close")
(M #:add-header #:Content-Type "text/html")
(M #:add-content
"<HTML><HEAD><TITLE>Time servlet</TITLE></HEAD>"
"<BODY><H2>Time servlet</H2>"
"<P>Current local time on this server: "
(strftime "%H:%M" (localtime (current-time)))
"</P></BODY></HTML>")
(M #:send-reply)))
;; Register the user servlet to respond for all URLs below `/user'.
;;
(add-dynamic-handler!
"/user"
(lambda (M in-port upath headers)
(add-standard-headers M)
(M #:set-reply-status:success)
(M #:add-header #:Connection "close")
(M #:add-header #:Content-Type "text/html")
(M #:add-content
"<HTML><HEAD><TITLE>User servlet</TITLE></HEAD>"
"<BODY><H2>User servlet</H2>"
"<P>This is the servlet from the Sizzle distribution talking.</P>"
"<P>You requested <TT>" upath "</TT>.</P></BODY></HTML>")
(M #:send-reply)))
;; A dynamic upath handler for .shtml files. File contents are scanned
;; for `<!--#SSIKEY VAR=VAL-->' comments, which are replaced w/ the
;; appropriate "server-side include" output. At this time, only
;; `#include' and `#exec' are handled. Fully expanded:
;;
;; <!--#include filename="FILENAME"-->
;; <!--#exec cmd="PROGRAM [ARGS ...]"-->
;;
;; Note that the double-quotes are required. [This may differ somewhat
;; from Apache behavior -- sorry, manual not handy at the moment, this
;; is from memory. We should probably fix this to make it mimic Apache
;; as much as possible to avoid user confusion. -ttn]
;;
(add-dynamic-handler!
"\\.shtml$"
(lambda (M in-port upath headers)
(add-standard-headers M)
(M #:set-reply-status:success)
(M #:add-header #:Connection "close")
(M #:add-header #:Content-Type "text/html")
(let* ((rx (make-regexp "<!--#([a-z]+) ([a-z]+)=\"([^>]+)\"-->"))
(ssi (fs-name upath))
(str (slurp ssi))
(max (string-length str))
(c '()))
;; do two passes to allow for validation (tbd)
(let loop ((start 0) (acc '()))
(if (>= start max)
(set! c (reverse acc))
(let ((m (regexp-exec rx str start)))
(if m
(loop (match:end m)
(cons (cons (string->symbol (match:substring m 1))
(match:substring m 3))
(cons (substring str start (match:start m))
acc)))
(loop max (cons (substring str start max) acc))))))
(chdir (dirname ssi))
(for-each (lambda (chunk)
(M #:add-content
(if (string? chunk)
chunk
(case (car chunk)
((include)
(slurp (cdr chunk)))
((exec)
(shell-command-to-string (cdr chunk)))
(else "(???)")))))
c))
(M #:send-reply)))
;;; mgrabmue-servlets.scm ends here
[-- Attachment #4: Type: text/plain, Size: 139 bytes --]
_______________________________________________
Guile-user mailing list
Guile-user@gnu.org
http://mail.gnu.org/mailman/listinfo/guile-user
^ permalink raw reply [flat|nested] 6+ messages in thread* Re: Guile & Sablotron
2004-03-09 17:32 Guile & Sablotron Brian S McQueen
2004-03-12 8:52 ` Thien-Thi Nguyen
2004-03-14 9:09 ` XML, HTML and Scheme (was: Guile & Sablotron) Daniel Skarda
@ 2004-03-15 16:36 ` Mike Gran
2004-03-18 0:02 ` Christopher Cramer
3 siblings, 0 replies; 6+ messages in thread
From: Mike Gran @ 2004-03-15 16:36 UTC (permalink / raw)
--- Brian S McQueen <bqueen@nas.nasa.gov> wrote:
> I want to put a Guile interface on the Sablotron
> library: http://www.gingerall.com/charlie/ga/xml/p_sab.xml
> In the short term I want to be able to use Sablotron as my template
> engine, from my Scheme programs. In the longterm I want to add this
> Guile/Sablotron binding to the Recluse web server:
Actually, it might be more efficient to do the binding for the XSLT lib
and the webserver binding at the same time. That way, you'd only have
to wrap the API relevant to CGI processing, which wouldn't take much
time at all.
You mentioned Recluse as a server. As ttn pointed out, there is an all
guile httpd solution (from guile-www). Also, there is a good,
Guile-friendly webserver named Serveez. I wonder how their performance
compares?
-Mike Gran
__________________________________
Do you Yahoo!?
Yahoo! Mail - More reliable, more storage, less spam
http://mail.yahoo.com
_______________________________________________
Guile-user mailing list
Guile-user@gnu.org
http://mail.gnu.org/mailman/listinfo/guile-user
^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: Guile & Sablotron
2004-03-09 17:32 Guile & Sablotron Brian S McQueen
` (2 preceding siblings ...)
2004-03-15 16:36 ` Guile & Sablotron Mike Gran
@ 2004-03-18 0:02 ` Christopher Cramer
2004-04-20 17:59 ` Kirill Lisovsky
3 siblings, 1 reply; 6+ messages in thread
From: Christopher Cramer @ 2004-03-18 0:02 UTC (permalink / raw)
On Tue, Mar 09, 2004 at 09:32:05AM -0800, Brian S McQueen wrote:
> Guile & Sablotron! Who is interested? I need to discuss this with
> someone! TTN! You do a lot of web work. Using a template engine is the
> way to go for handling the presentation of data. The programs can produce
> generic data of this sort:
>
> <sales>
>
> <division id="North">
> <revenue>10</revenue>
> <growth>9</growth>
> <bonus>7</bonus>
> </division>
>
> <division id="South">
> <revenue>4</revenue>
> <growth>3</growth>
> <bonus>4</bonus>
> </division>
>
> <division id="West">
> <revenue>6</revenue>
> <growth>-1.5</growth>
> <bonus>2</bonus>
> </division>
>
> </sales>
I'm pretty much sold on the idea of integrating templates into Recluse.
But that sort of output seems a little less elegant than I would like.
You'd end up with display or format calls outputting XML, which is an
improvement over outputting HTML, but I wonder if instead of outputting
XML we could just return a list.
Something like:
'(sales
(division (id "North")
(revenue 10)
(growth 9)
(bonus 7))
(division (id "South")
(revenue 4)
(growth 3)
(bonus 4)))
I think being able to write the whole thing using just sql->list, map,
append, etc. (or even backquotes) would make it a lot easier.
I suppose there might be interoperability benefits to using XML though.
Maybe we should have some ->xml and xml-> procedures.
--
Christopher Cramer <crayc@pyro.net> <http://www.pyro.net/~crayc/>
In politics you have to understand not where the voters are when a poll
is taken, but where they are likely to end up on Election Day.
-- Rep. Tom Davis, former NRCC Chairman
_______________________________________________
Guile-user mailing list
Guile-user@gnu.org
http://mail.gnu.org/mailman/listinfo/guile-user
^ permalink raw reply [flat|nested] 6+ messages in thread