On Sat, 8 Apr 2006, DaishiKato wrote:
At Fri, 7 Apr 2006 17:27:43 +0000 (GMT),
Thomas Chust wrote:
This works on my machine and looks fine as far as the use of the openssl
egg is concerned. I would like to remark, though, that it may be useful if
one could somehow specify the second optional parameter to ssl-connect to
enable SSL protocol version selection and certificate management -- maybe
one could hack an additional field into the http:request structure.
You are absolutely right.
In fact, I was wondering how to specify CA certificates.
Here is a new patch.
Great, looks good and works fine.
I think it should be possible to just create a version of http:GET with
three optional arguments, [...]
This is still different from what I desire.
I was thinking something like a global pool of connections
for each host:port, and a client program does not need to
keep track of input and output ports.
It can even seamlessly re-connect, once the old connection is closed.
[...]
I have previously implemented this type of connection management in the
rpc egg, so I threw together some code from there and from http-client to
create an interface that seems to work fine. The source code is attached
to this e-mail.
cu,
Thomas
;;;; persistent-http-get.scm
;;;; A replacement for http:GET that uses a pool of persistent connections
(define-extension persistent-http-get
(export
persistent-http:is-connected? persistent-http:get-connection
persistent-http:close-connection! persistent-http:close-all-connections!
persistent-http:GET))
(require-extension (srfi 18) (srfi 69) extras url http-utils http-client)
;;; Network support routines
#>
#ifdef _WIN32
#if _MSC_VER > 1300
#include <winsock2.h>
#else /* _MSC_VER */
#include <winsock.h>
#endif /* _MSC_VER */
#else /* _WIN32 */
#include <netinet/in.h>
#include <netdb.h>
#endif /* _WIN32 */
<#
(define (get-port-by-service-name svc)
(let ((port ((foreign-lambda* scheme-object ((c-string svc))
"struct servent *sve =\n"
" getservbyname(svc, \"tcp\");\n"
"return(sve == NULL\n"
" ? C_SCHEME_FALSE\n"
" : C_fix(ntohs(sve->s_port)));\n")
svc)))
(if port
port
(error 'get-port-by-service-name "unknown service" svc))))
;;; Thread local connection pool
(define connections
(make-parameter (make-hash-table equal?)))
(define connections-owner
(make-parameter (current-thread)))
(define (ensure-local-connections)
(unless (eq? (connections-owner) (current-thread))
(connections (make-hash-table equal?))
(connections-owner (current-thread))))
(define (request-server-id req)
(let* ((req (if (string? req)
(http:make-request 'GET req)
req))
(u (url (http:request-url req)))
(scheme (or (url-scheme u) "http"))
(host (or (http:request-ip req) (url-host u)))
(port (or (url-port u) (get-port-by-service-name scheme))))
(sprintf "~A://[EMAIL PROTECTED]:~A" scheme (url-user u) host port)))
(define (persistent-http:is-connected? req)
(ensure-local-connections)
(hash-table-exists? (connections) (request-server-id req)))
(define (persistent-http:get-connection req)
(ensure-local-connections)
(apply values (hash-table-ref (connections) (request-server-id req))))
(define (persistent-http:close-connection! req)
(ensure-local-connections)
(let ((key (request-server-id req)))
(let ((con (hash-table-ref (connections) key)))
(hash-table-delete! (connections) key)
(close-input-port (car con))
(close-output-port (cadr con)))))
(define (persistent-http:close-all-connections!)
(ensure-local-connections)
(hash-table-walk
(connections)
(lambda (key con)
(hash-table-delete! (connections) key)
(close-input-port (car con))
(close-output-port (cadr con)))))
;;; HTTP client functionality
(define (persistent-http:GET req #!optional (keep-alive? #t))
(ensure-local-connections)
(let* ((req (if (string? req)
(http:make-request
'GET req
`(("Connection" . ,(if keep-alive?
"keep-alive"
"close"))))
req))
(key (request-server-id req))
(stat #f)
(hdrs '())
(in #f)
(out #f))
(dynamic-wind
void
(lambda ()
(set!-values
(in out)
(apply values (hash-table-ref/default (connections) key '(#f #f))))
(let retry ()
(condition-case
(set!-values
(stat hdrs in out)
(http:send-request req in out))
(exn (exn i/o net)
(if (and in out)
(begin
(close-input-port in)
(close-output-port out)
(hash-table-delete! (connections) key)
(set! in #f)
(set! out #f)
(retry))
(signal exn)))))
(if (eof-object? stat)
#!eof
(read-string
(cond
((alist-ref "content-length" hdrs equal?)
=> string->number)
(else
#f))
in)))
(lambda ()
(if (and keep-alive?
(not (string-ci=?
(alist-ref "connection" hdrs equal? "")
"close")))
(hash-table-set! (connections) key (list in out))
(begin
(close-input-port in)
(close-output-port out)
(hash-table-delete! (connections) key)))))))
;;;; vim:set shiftwidth=2 softtabstop=2: ;;;;
_______________________________________________
Chicken-users mailing list
Chicken-users@nongnu.org
http://lists.nongnu.org/mailman/listinfo/chicken-users
