Indenting and bug 7544
svn: r627
This commit is contained in:
Jay McCarthy
parent
19b1ddfa72
commit
0987bcd1dd
|
|
@ -14,18 +14,18 @@
|
|||
(lib "string.ss")
|
||||
(lib "url.ss" "net")
|
||||
(lib "xml.ss" "xml")
|
||||
)
|
||||
(lib "list.ss"))
|
||||
(provide web-server@)
|
||||
|
||||
|
||||
(define myprint
|
||||
(lambda args
|
||||
(apply fprintf (cons (current-error-port) args))))
|
||||
|
||||
|
||||
|
||||
|
||||
;; ****************************************
|
||||
;; stick this auxilliary outside the unit so
|
||||
;; I can get at it with require/expose
|
||||
|
||||
|
||||
;; get-host : Url (listof (cons Symbol String)) -> String
|
||||
;; host names are case insesitive---Internet RFC 1034
|
||||
(define DEFAULT-HOST-NAME "<none>")
|
||||
|
|
@ -40,20 +40,20 @@
|
|||
=>
|
||||
(lambda (h) (lower! (bytes->string/utf-8 (cdr h))))]
|
||||
[else DEFAULT-HOST-NAME])))
|
||||
|
||||
|
||||
;; ****************************************
|
||||
|
||||
|
||||
(define web-server@
|
||||
(unit/sig web-server^
|
||||
(import net:tcp^ (config : web-config^))
|
||||
|
||||
|
||||
(define current-server-custodian (make-parameter #f))
|
||||
|
||||
|
||||
;; make-servlet-custodian: -> custodian
|
||||
;; create a custodian for the dynamic extent of a servlet continuation
|
||||
(define (make-servlet-custodian)
|
||||
(make-custodian (current-server-custodian)))
|
||||
|
||||
|
||||
;; serve: -> -> void
|
||||
;; start the server and return a thunk to shut it down
|
||||
(define (serve)
|
||||
|
|
@ -77,7 +77,7 @@
|
|||
(server-loop get-ports)))))
|
||||
(lambda ()
|
||||
(custodian-shutdown-all the-server-custodian))))
|
||||
|
||||
|
||||
;; server-loop: (-> i-port o-port) -> void
|
||||
;; start a thread to handle each incoming connection
|
||||
(define (server-loop get-ports)
|
||||
|
|
@ -91,7 +91,7 @@
|
|||
(new-connection config:initial-connection-timeout
|
||||
ip op (current-custodian) #f))))))
|
||||
(loop))))
|
||||
|
||||
|
||||
;; serve-ports : input-port output-port -> void
|
||||
;; returns immediately, spawning a thread to handle
|
||||
;; the connection
|
||||
|
|
@ -108,7 +108,7 @@
|
|||
(serve-connection
|
||||
(new-connection config:initial-connection-timeout
|
||||
ip op connection-cust #f)))))))
|
||||
|
||||
|
||||
;; serve-connection: connection -> void
|
||||
;; respond to all requests on this connection
|
||||
(define (serve-connection conn)
|
||||
|
|
@ -117,16 +117,16 @@
|
|||
(let* ([host (get-host (request-uri req) (request-headers req))]
|
||||
[host-conf (config:virtual-hosts host)])
|
||||
((host-log-message host-conf) (request-host-ip req)
|
||||
(request-client-ip req) (request-method req) (request-uri req) host)
|
||||
(request-client-ip req) (request-method req) (request-uri req) host)
|
||||
(set-connection-close?! conn close?)
|
||||
(dispatch conn req host-conf)
|
||||
(adjust-connection-timeout! conn config:initial-connection-timeout)
|
||||
(cond
|
||||
[close? (kill-connection! conn)]
|
||||
[else (connection-loop)])))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;; dispatch: connection request host -> void
|
||||
;; NOTE: (GregP) I'm going to use the dispatch logic out of v208 for now.
|
||||
;; I will move the other dispatch logic out of the prototype
|
||||
|
|
@ -136,91 +136,91 @@
|
|||
[method (request-method req)]
|
||||
[path (translate-escapes (url-path->string (url-path uri)))])
|
||||
(cond
|
||||
[(access-denied? method path (request-headers req) host-info
|
||||
config:access)
|
||||
=> (lambda (realm)
|
||||
(adjust-connection-timeout! conn (timeouts-password
|
||||
(host-timeouts host-info)))
|
||||
(request-authentication conn method uri host-info realm))]
|
||||
[(conf-prefix? path)
|
||||
(cond
|
||||
[(string=? "/conf/refresh-servlets" path)
|
||||
;; more here - this is broken - only out of date or specifically mentioned
|
||||
;; scripts should be flushed. This destroys persistent state!
|
||||
(call-with-semaphore config:scripts-lock
|
||||
(lambda ()
|
||||
(set-box! config:scripts (make-hash-table 'equal))))
|
||||
(output-response/method
|
||||
conn
|
||||
((responders-servlets-refreshed (host-responders host-info)))
|
||||
method)]
|
||||
[(string=? "/conf/refresh-passwords" path)
|
||||
;; more here - send a nice error page
|
||||
(hash-table-put! config:access host-info
|
||||
(read-passwords host-info))
|
||||
(output-response/method
|
||||
conn
|
||||
((responders-passwords-refreshed (host-responders host-info)))
|
||||
method)
|
||||
]
|
||||
[else
|
||||
(output-response/method
|
||||
conn
|
||||
((responders-file-not-found (host-responders host-info)) uri)
|
||||
method)])]
|
||||
[(servlet-bin? path)
|
||||
(adjust-connection-timeout!
|
||||
conn
|
||||
(timeouts-servlet-connection (host-timeouts host-info)))
|
||||
;; more here - make timeouts proportional to size of bindings
|
||||
(servlet-content-producer conn req host-info)]
|
||||
|
||||
[else (file-content-producer conn req host-info)])))
|
||||
|
||||
|
||||
[(access-denied? method path (request-headers req) host-info
|
||||
config:access)
|
||||
=> (lambda (realm)
|
||||
(adjust-connection-timeout! conn (timeouts-password
|
||||
(host-timeouts host-info)))
|
||||
(request-authentication conn method uri host-info realm))]
|
||||
[(conf-prefix? path)
|
||||
(cond
|
||||
[(string=? "/conf/refresh-servlets" path)
|
||||
;; more here - this is broken - only out of date or specifically mentioned
|
||||
;; scripts should be flushed. This destroys persistent state!
|
||||
(call-with-semaphore config:scripts-lock
|
||||
(lambda ()
|
||||
(set-box! config:scripts (make-hash-table 'equal))))
|
||||
(output-response/method
|
||||
conn
|
||||
((responders-servlets-refreshed (host-responders host-info)))
|
||||
method)]
|
||||
[(string=? "/conf/refresh-passwords" path)
|
||||
;; more here - send a nice error page
|
||||
(hash-table-put! config:access host-info
|
||||
(read-passwords host-info))
|
||||
(output-response/method
|
||||
conn
|
||||
((responders-passwords-refreshed (host-responders host-info)))
|
||||
method)
|
||||
]
|
||||
[else
|
||||
(output-response/method
|
||||
conn
|
||||
((responders-file-not-found (host-responders host-info)) uri)
|
||||
method)])]
|
||||
[(servlet-bin? path)
|
||||
(adjust-connection-timeout!
|
||||
conn
|
||||
(timeouts-servlet-connection (host-timeouts host-info)))
|
||||
;; more here - make timeouts proportional to size of bindings
|
||||
(servlet-content-producer conn req host-info)]
|
||||
|
||||
[else (file-content-producer conn req host-info)])))
|
||||
|
||||
|
||||
;; conf-prefix?: string -> (union (listof string) #f)
|
||||
;; does the path string have "/conf/" as a prefix?
|
||||
(define conf-prefix?
|
||||
(let ([conf-re (regexp "^/conf/.*")])
|
||||
(lambda (str)
|
||||
(regexp-match conf-re str))))
|
||||
|
||||
|
||||
(define servlet-bin?
|
||||
(let ([svt-bin-re (regexp "^/servlets/.*")])
|
||||
(lambda (str)
|
||||
(regexp-match svt-bin-re str))))
|
||||
|
||||
|
||||
;; ripped this off from url-unit.ss
|
||||
(define (url-path->string strs)
|
||||
(apply
|
||||
string-append
|
||||
(let loop ([strs strs])
|
||||
(cond
|
||||
[(null? strs) '()]
|
||||
[else (list* "/"
|
||||
(maybe-join-params (car strs))
|
||||
(loop (cdr strs)))]))))
|
||||
|
||||
[(null? strs) '()]
|
||||
[else (list* "/"
|
||||
(maybe-join-params (car strs))
|
||||
(loop (cdr strs)))]))))
|
||||
|
||||
;; needs to unquote things!
|
||||
(define (maybe-join-params s)
|
||||
(cond
|
||||
[(string? s) s]
|
||||
[else (path/param-path s)]))
|
||||
|
||||
[(string? s) s]
|
||||
[else (path/param-path s)]))
|
||||
|
||||
;; ****************************************
|
||||
;; ****************************************
|
||||
;; ACCESS CONTROL
|
||||
|
||||
|
||||
;; pass-entry = (make-pass-entry str regexp (list sym str))
|
||||
(define-struct pass-entry (domain pattern users))
|
||||
|
||||
|
||||
;; access-denied? : Method string x-table host Access-table -> (+ false str)
|
||||
;; the return string is the prompt for authentication
|
||||
(define (access-denied? method uri-str headers host-info access-table)
|
||||
;; denied?: str sym str -> (U str #f)
|
||||
;; a function to authenticate the user
|
||||
(let ([denied?
|
||||
|
||||
|
||||
;; GregP lookup the authenticator function, if you can't find it, then try to load the
|
||||
;; passwords file for this host.
|
||||
(hash-table-get
|
||||
|
|
@ -234,9 +234,9 @@
|
|||
(if user-pass
|
||||
(denied? uri-str (lowercase-symbol! (car user-pass)) (cdr user-pass))
|
||||
(denied? uri-str fake-user "")))))
|
||||
|
||||
|
||||
(define-struct (exn:password-file exn) ())
|
||||
|
||||
|
||||
;; : host -> (str sym str -> (U str #f))
|
||||
;; to produce a function that checks if a given url path is accessible by a given user with a given
|
||||
;; password. If not, the produced function returns a string, prompting for the password.
|
||||
|
|
@ -254,7 +254,7 @@
|
|||
(raise "malformed passwords"))
|
||||
(map (lambda (x) (make-pass-entry (car x) (regexp (cadr x)) (cddr x)))
|
||||
raw))])
|
||||
|
||||
|
||||
;; string symbol bytes -> (union #f string)
|
||||
(lambda (request-path user-name password)
|
||||
(ormap (lambda (x)
|
||||
|
|
@ -268,11 +268,11 @@
|
|||
(pass-entry-domain x)))))
|
||||
passwords)))
|
||||
(lambda (req user pass) #f)))))
|
||||
|
||||
|
||||
(define fake-user (gensym))
|
||||
|
||||
|
||||
;; password-list? : TST -> bool
|
||||
|
||||
|
||||
;; Note: andmap fails for dotted pairs at end.
|
||||
;; This is okay, since #f ends up raising a caught exception anyway.
|
||||
(define (password-list? passwords)
|
||||
|
|
@ -286,7 +286,7 @@
|
|||
(symbol? (car x)) (string? (cadr x))))
|
||||
(cddr domain))))
|
||||
passwords)))
|
||||
|
||||
|
||||
;; request-authentication : connection Method URL iport oport host str bool -> bool
|
||||
;; GregP: at first look, it seems that this gets called when the user
|
||||
;; has supplied bad authentication credentials.
|
||||
|
|
@ -297,16 +297,16 @@
|
|||
uri `(WWW-Authenticate . ,(string-append " Basic
|
||||
realm=\"" realm "\"")))
|
||||
method))
|
||||
|
||||
|
||||
|
||||
|
||||
;; ************************************************************
|
||||
;; ************************************************************
|
||||
;; SERVING FILES
|
||||
|
||||
|
||||
;; file-content-producer: connection request host -> void
|
||||
(define (file-content-producer conn req host-info)
|
||||
(serve-file conn (request-method req) (request-uri req) host-info))
|
||||
|
||||
|
||||
;; serve-file : connection symbol uri host -> void
|
||||
;; to find the file, including searching for implicit index files, and serve it out
|
||||
(define (serve-file conn method uri host-info)
|
||||
|
|
@ -318,32 +318,32 @@
|
|||
[(directory-exists? path)
|
||||
(let loop ([dir-defaults (host-indices host-info)])
|
||||
(cond
|
||||
[(pair? dir-defaults)
|
||||
(let ([full-name (build-path path (car dir-defaults))])
|
||||
(if (file-exists? full-name)
|
||||
(cond
|
||||
[(looks-like-directory? (url-path->string (url-path uri)))
|
||||
(output-file conn full-name method (get-mime-type full-name))]
|
||||
[else
|
||||
(output-slash-message conn method (url-path->string (url-path uri)))])
|
||||
(loop (cdr dir-defaults))))]
|
||||
[else
|
||||
(output-response/method
|
||||
conn
|
||||
((responders-file-not-found
|
||||
(host-responders host-info)) uri)
|
||||
method)]))]
|
||||
[(pair? dir-defaults)
|
||||
(let ([full-name (build-path path (car dir-defaults))])
|
||||
(if (file-exists? full-name)
|
||||
(cond
|
||||
[(looks-like-directory? (url-path->string (url-path uri)))
|
||||
(output-file conn full-name method (get-mime-type full-name))]
|
||||
[else
|
||||
(output-slash-message conn method (url-path->string (url-path uri)))])
|
||||
(loop (cdr dir-defaults))))]
|
||||
[else
|
||||
(output-response/method
|
||||
conn
|
||||
((responders-file-not-found
|
||||
(host-responders host-info)) uri)
|
||||
method)]))]
|
||||
[else
|
||||
(output-response/method
|
||||
conn ((responders-file-not-found (host-responders host-info))
|
||||
uri)
|
||||
method)])))
|
||||
|
||||
|
||||
;; looks-like-directory : str -> bool
|
||||
;; to determine if is url style path looks like it refers to a directory
|
||||
(define (looks-like-directory? path)
|
||||
(eq? #\/ (string-ref path (sub1 (string-length path)))))
|
||||
|
||||
|
||||
;; output-slash-message: connection symbol string -> void
|
||||
;; basically this is just a special error response
|
||||
(define (output-slash-message conn method url-path-str)
|
||||
|
|
@ -364,18 +364,18 @@
|
|||
url-path-str "/")])
|
||||
"this url") " instead."))))))
|
||||
method))
|
||||
|
||||
|
||||
;; xml->string: xml -> string
|
||||
(define (xml->string some-xml)
|
||||
(let ([o-port (open-output-string)])
|
||||
(write-xml/content some-xml o-port)
|
||||
(get-output-string o-port)))
|
||||
|
||||
|
||||
|
||||
|
||||
;; ************************************************************
|
||||
;; ************************************************************
|
||||
;; SERVING SERVLETS
|
||||
|
||||
|
||||
;; servlet-content-producer: connection request host -> void
|
||||
(define (servlet-content-producer conn req host-info)
|
||||
(let ([meth (request-method req)])
|
||||
|
|
@ -391,14 +391,14 @@
|
|||
req
|
||||
(read-bindings/handled conn meth uri (request-headers req)
|
||||
host-info))
|
||||
|
||||
|
||||
(cond
|
||||
[(continuation-url? uri)
|
||||
=> (lambda (k-ref)
|
||||
(invoke-servlet-continuation conn req k-ref host-info))]
|
||||
[else
|
||||
(servlet-content-producer/path conn req host-info uri)])))))
|
||||
|
||||
[(continuation-url? uri)
|
||||
=> (lambda (k-ref)
|
||||
(invoke-servlet-continuation conn req k-ref host-info))]
|
||||
[else
|
||||
(servlet-content-producer/path conn req host-info uri)])))))
|
||||
|
||||
;; read-bindings/handled: connection symbol url headers host -> (listof (list (symbol string))
|
||||
;; read the bindings and handle any exceptions
|
||||
(define (read-bindings/handled conn meth uri headers host-info)
|
||||
|
|
@ -406,27 +406,27 @@
|
|||
(output-response/method
|
||||
conn
|
||||
;((responders-protocol (host-responders host-info))
|
||||
; (exn-message e))
|
||||
; (exn-message e))
|
||||
((responders-servlet-loading (host-responders
|
||||
host-info))
|
||||
uri e)
|
||||
|
||||
|
||||
|
||||
|
||||
meth)
|
||||
'())])
|
||||
(read-bindings conn meth uri headers)))
|
||||
|
||||
|
||||
;; servlet-content-producer/path: connection request host url -> void
|
||||
;; This is not a continuation url so the loading behavior is determined
|
||||
;; by the url path. Build the servlet path and then load the servlet
|
||||
(define (servlet-content-producer/path conn req host-info uri)
|
||||
(with-handlers (;; couldn't find the servlet
|
||||
[exn:fail:filesystem:exists:servlet?
|
||||
(lambda (the-exn)
|
||||
(output-response/method
|
||||
(lambda (the-exn)
|
||||
(output-response/method
|
||||
conn
|
||||
((responders-file-not-found (host-responders
|
||||
host-info))
|
||||
host-info))
|
||||
(request-uri req))
|
||||
(request-method req)))]
|
||||
;; servlet won't load (e.g. syntax error)
|
||||
|
|
@ -436,9 +436,9 @@
|
|||
conn
|
||||
((responders-servlet-loading (host-responders
|
||||
host-info)) uri
|
||||
the-exn)
|
||||
the-exn)
|
||||
(request-method req)))])
|
||||
|
||||
|
||||
(let ([sema (make-semaphore 0)])
|
||||
(let/cc suspend
|
||||
(let* ([servlet-custodian (make-servlet-custodian)]
|
||||
|
|
@ -446,19 +446,19 @@
|
|||
config:instances servlet-custodian
|
||||
(make-execution-context
|
||||
conn req (lambda () (suspend #t)))
|
||||
sema)]
|
||||
sema)]
|
||||
[real-servlet-path (url-path->path
|
||||
(paths-servlet (host-paths host-info))
|
||||
(url-path->string (url-path uri)))]
|
||||
[servlet-exit-handler (make-servlet-exit-handler inst)]
|
||||
)
|
||||
|
||||
|
||||
(parameterize ([current-directory (get-servlet-base-dir real-servlet-path)]
|
||||
[current-custodian servlet-custodian]
|
||||
[current-servlet-instance inst]
|
||||
[exit-handler servlet-exit-handler])
|
||||
|
||||
|
||||
|
||||
|
||||
(let (;; timer thread must be within the dynamic extent of
|
||||
;; servlet custodian
|
||||
[time-bomb (start-timer (timeouts-default-servlet
|
||||
|
|
@ -469,18 +469,18 @@
|
|||
;; servlet is loaded should be within the dynamic
|
||||
;; extent of the servlet custodian
|
||||
[servlet-program (cached-load real-servlet-path)])
|
||||
|
||||
|
||||
(with-handlers ([(lambda (x) #t)
|
||||
(make-servlet-exception-handler inst
|
||||
host-info)])
|
||||
|
||||
|
||||
|
||||
|
||||
;; The following bindings need to be in scope for the
|
||||
;; invoke-unit/sig
|
||||
(let ([adjust-timeout!
|
||||
(lambda (secs) (reset-timer time-bomb secs))]
|
||||
[initial-request req])
|
||||
|
||||
|
||||
;; Two possibilities:
|
||||
;; - module servlet. start : Request -> Void handles
|
||||
;; output-response via send/finish, etc.
|
||||
|
|
@ -493,7 +493,7 @@
|
|||
(when (response? r)
|
||||
(send/back r)))))))))
|
||||
(semaphore-post sema))))
|
||||
|
||||
|
||||
;; make-servlet-exit-handler: servlet-instance -> alpha -> void
|
||||
;; exit handler for a servlet
|
||||
(define (make-servlet-exit-handler inst)
|
||||
|
|
@ -503,7 +503,7 @@
|
|||
(execution-context-connection
|
||||
(servlet-instance-context inst)))
|
||||
(custodian-shutdown-all (servlet-instance-custodian inst))))
|
||||
|
||||
|
||||
;; make-servlet-exception-handler: host -> exn -> void
|
||||
;; This exception handler traps all unhandled servlet exceptions
|
||||
;; * Must occur within the dynamic extent of the servlet
|
||||
|
|
@ -529,19 +529,19 @@
|
|||
(execution-context-connection ctxt)
|
||||
resp (request-method req))
|
||||
((execution-context-suspend ctxt)))))
|
||||
|
||||
|
||||
;; path -> path
|
||||
;; The actual servlet's parent directory.
|
||||
(define (get-servlet-base-dir servlet-path)
|
||||
(let loop ((path servlet-path))
|
||||
(let-values ([(base name must-be-dir?) (split-path path)])
|
||||
(if must-be-dir?
|
||||
(or (and (directory-exists? path) path)
|
||||
(loop base))
|
||||
(or (and (directory-exists? base) base)
|
||||
(loop base))))))
|
||||
|
||||
|
||||
(or (and (directory-exists? path) path)
|
||||
(loop base))
|
||||
(or (and (directory-exists? base) base)
|
||||
(loop base))))))
|
||||
|
||||
|
||||
;; invoke-servlet-continuation: connection request continuation-reference
|
||||
;; host -> void
|
||||
;; pull the continuation out of the table and apply it
|
||||
|
|
@ -562,36 +562,38 @@
|
|||
host-info))
|
||||
(request-uri req))
|
||||
(request-method req)))])
|
||||
(let* ([inst (hash-table-get config:instances (car k-ref)
|
||||
(lambda ()
|
||||
(raise
|
||||
(make-exn:servlet-instance
|
||||
"" (current-continuation-marks)))))]
|
||||
(let* ([inst
|
||||
(hash-table-get config:instances (first k-ref)
|
||||
(lambda ()
|
||||
(raise
|
||||
(make-exn:servlet-instance
|
||||
"" (current-continuation-marks)))))]
|
||||
[k-table
|
||||
(servlet-instance-k-table inst)])
|
||||
(let/cc suspend
|
||||
(set-servlet-instance-context!
|
||||
inst
|
||||
(make-execution-context
|
||||
conn req (lambda () (suspend #t))))
|
||||
(semaphore-wait (servlet-instance-mutex inst))
|
||||
(let ((k*salt
|
||||
(hash-table-get k-table (cadr k-ref)
|
||||
(lambda ()
|
||||
(raise
|
||||
(make-exn:servlet-continuation
|
||||
"" (current-continuation-marks)))))))
|
||||
(if (= (cadr k*salt) (caddr k-ref))
|
||||
((car k*salt) req)
|
||||
inst
|
||||
(make-execution-context
|
||||
conn req (lambda () (suspend #t))))
|
||||
(let ([k*salt
|
||||
(call-with-semaphore
|
||||
(servlet-instance-mutex inst)
|
||||
(lambda ()
|
||||
(hash-table-get k-table (second k-ref)
|
||||
(lambda ()
|
||||
(raise
|
||||
(make-exn:servlet-continuation
|
||||
"" (current-continuation-marks)))))))])
|
||||
(if (= (second k*salt) (third k-ref))
|
||||
((first k*salt) req)
|
||||
(raise
|
||||
(make-exn:servlet-continuation
|
||||
"" (current-continuation-marks))))))
|
||||
(semaphore-post (servlet-instance-mutex inst)))))
|
||||
|
||||
"" (current-continuation-marks)))))))))
|
||||
|
||||
;; ************************************************************
|
||||
;; ************************************************************
|
||||
;; Paul's ugly loading code:
|
||||
|
||||
|
||||
;; cached-load : str -> script
|
||||
;; timestamps are no longer checked for performance. The cache must be explicitly
|
||||
;; refreshed (see dispatch).
|
||||
|
|
@ -601,12 +603,12 @@
|
|||
(hash-table-get (unbox config:scripts)
|
||||
name
|
||||
(lambda () (reload-servlet-script name))))))
|
||||
|
||||
|
||||
;; exn:i/o:filesystem:servlet-not-found =
|
||||
;; (make-exn:fail:filesystem:exists:servlet str continuation-marks str sym)
|
||||
(define-struct (exn:fail:filesystem:exists:servlet
|
||||
exn:fail:filesystem:exists) ())
|
||||
|
||||
|
||||
;; reload-servlet-script : str -> script
|
||||
;; The servlet is not cached in the servlet-table, so reload it from the filesystem.
|
||||
(define (reload-servlet-script servlet-filename)
|
||||
|
|
@ -620,8 +622,8 @@
|
|||
(raise (make-exn:fail:filesystem:exists:servlet
|
||||
(string->immutable-string (format "Couldn't find ~a" servlet-filename))
|
||||
(current-continuation-marks) ))]))
|
||||
|
||||
;; load-servlet/path path -> (union #f signed-unit)
|
||||
|
||||
;; load-servlet/path path -> (union #f signed-unit)
|
||||
;; given a string path to a filename attempt to load a servlet
|
||||
;; A servlet-file will contain either
|
||||
;;;; A signed-unit-servlet
|
||||
|
|
@ -665,5 +667,5 @@
|
|||
(unit/sig () (import servlet^) (go)))]
|
||||
[else
|
||||
(raise (format "Loading ~e produced ~n~e~n instead of a servlet." a-path s))]))))
|
||||
|
||||
|
||||
)))
|
||||
Loading…
Reference in New Issue
Block a user