# # The httpd_ procedures implement a stub http server. # # Copyright (c) 1997-1998 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # SCCS: @(#) httpd 1.2 98/02/20 14:51:59 #set httpLog 1 proc httpd_init {{port 8015}} { socket -server httpdAccept $port } proc httpd_log {args} { global httpLog if {[info exists httpLog] && $httpLog} { puts stderr "httpd: [join $args { }]" } } array set httpdErrors { 204 {No Content} 400 {Bad Request} 404 {Not Found} 503 {Service Unavailable} 504 {Service Temporarily Unavailable} } proc httpdError {sock code args} { global httpdErrors puts $sock "$code $httpdErrors($code)" httpd_log "error: [join $args { }]" } proc httpdAccept {newsock ipaddr port} { global httpd upvar #0 httpd$newsock data fconfigure $newsock -blocking 0 -translation {auto crlf} httpd_log $newsock Connect $ipaddr $port set data(ipaddr) $ipaddr fileevent $newsock readable [list httpdRead $newsock] } # read data from a client request proc httpdRead { sock } { upvar #0 httpd$sock data if {![info exists data(state)]} { set readCount [gets $sock line] if [regexp {(POST|GET|HEAD) ([^?]+)\??([^ ]*) HTTP/1.0} \ $line x data(proto) data(url) data(query)] { set data(state) mime httpd_log $sock Query $line } else { httpdError $sock 400 httpd_log $sock Error "bad first line:$line" httpdSockDone $sock } return } elseif {$data(state) == "mime"} { set readCount [gets $sock line] if {[regexp {Content-Length: (\d+)} $line match length]} { set data(length) $length } } elseif {$data(state) == "query"} { if {![info exist data(length_orig)]} { set data(length_orig) $data(length) } set line [read $sock $data(length)] set readCount [string length $line] incr data(length) -$readCount } # string compare $readCount 0 maps -1 to -1, 0 to 0, and > 0 to 1 set state [string compare $readCount 0],$data(state),$data(proto) httpd_log $sock $state switch -- $state { -1,mime,HEAD - -1,mime,GET - -1,mime,POST { # gets would block return } 0,mime,HEAD - 0,mime,GET - 0,query,POST { httpdRespond $sock } 0,mime,POST { set data(state) query } 1,mime,HEAD - 1,mime,POST - 1,mime,GET { if {[regexp {([^:]+):[ ]*(.*)} $line dummy key value]} { set data(mime,[string tolower $key]) $value } } -1,query,POST { httpd_log $sock Error "unexpected eof on <$data(url)> request" httpdError $sock 404 httpdSockDone $sock } 1,query,POST { append data(query) $line if {$data(length) <= 0} { set data(length) $data(length_orig) httpdRespond $sock } } default { if [eof $sock] { httpd_log $sock Error "unexpected eof on <$data(url)> request" } else { httpd_log $sock Error "unhandled state <$state> fetching <$data(url)>" } httpdError $sock 404 httpdSockDone $sock } } } proc httpdSockDone { sock } { upvar #0 httpd$sock data unset data close $sock } # Respond to the query. proc httpdRespond { sock } { global httpd bindata port upvar #0 httpd$sock data switch -glob -- $data(url) { *binary* { set html "$bindata[info hostname]:$port$data(url)" set type application/octet-stream } *post* { set html "Got [string length $data(query)] bytes" set type text/plain } default { set type text/html set html "