(define-module(www server-utils cgi-prep)#:export(cgi-environment-manager))
(define *env-jamming-methods* `(server-hostname "SERVER_NAME" gateway-interface "GATEWAY_INTERFACE" server-port("SERVER_PORT" unquote number->string)request-method "REQUEST_METHOD" path-info "PATH_INFO" path-translated "PATH_TRANSLATED" script-name "SCRIPT_NAME" query-string "QUERY_STRING" remote-host "REMOTE_HOST" remote-addr "REMOTE_ADDR" authentication-type "AUTH_TYPE" remote-user "REMOTE_USER" remote-ident "REMOTE_IDENT" content-type "CONTENT_TYPE" content-length("CONTENT_LENGTH" unquote(lambda(n)(and n(number->string n))))http-user-agent "HTTP_USER_AGENT" http-cookie "HTTP_COOKIE" server-software "SERVER_SOFTWARE" server-protocol "SERVER_PROTOCOL" http-accept-types("HTTP_ACCEPT" unquote(lambda(ls)(if(or(not ls)(null? ls))""(apply string-append(car ls)(apply append!(map(lambda(x)(list ", " x))(cdr ls)))))))))
(define *env-jamming*(let((ht(make-hash-table 23)))(let loop((ls *env-jamming-methods*))(or(null? ls)(begin(hashq-set! ht(car ls)(cadr ls))(loop(cddr ls)))))ht))
(define(cgi-environment-manager initial-bindings)(define(newhash)(make-hash-table 23))(let((init-ht(newhash))(addl-ht #f))(define(reset-addl!)(set! addl-ht(newhash)))(define(add! ht k v)(let*((method(or(hashq-ref *env-jamming* k)(error "unrecognized key:" k)))(lhs(if(pair? method)(car method)method))(rhs(if(pair? method)((cdr method)v)v)))(and rhs(hashq-set! ht k(simple-format #f "~A=~A" lhs rhs)))))(define(elist ht)(hash-fold(lambda(k v acc)(cons v acc)) '()ht))(reset-addl!)(for-each(lambda(binding)(add! init-ht(car binding)(cdr binding)))initial-bindings)(lambda (command . args)(if(symbol? command)(add! addl-ht command(car args))(case command((#:clear!)(reset-addl!))((#:environ-list)(append!(elist init-ht)(elist addl-ht)))(else(error "bad command:" command)))))))
