Skip to content

Commit

Permalink
Added optional configuration file argument to control script and upda…
Browse files Browse the repository at this point in the history
…ted README accordingly. Moved internal configuration from global to local. Changed some subscripts to uppercase for better consistency. Regrouped parsed request headers under their own subscript.
  • Loading branch information
lparenteau committed May 5, 2012
1 parent c846a5a commit 8997596
Show file tree
Hide file tree
Showing 7 changed files with 114 additions and 107 deletions.
6 changes: 3 additions & 3 deletions README.md
Original file line number Diff line number Diff line change
Expand Up @@ -4,13 +4,13 @@ HTTP server developed using GT.M.

## Configuring it

See conf/httpm.conf and modified to suits your needs.
See conf/httpm.conf and modify it to suits your needs, or copy, modify, and specify it as the second argument to httpm.sh.

## Starting the server

Start the server by executing `./script/httpm.sh start`.
Start the server by executing `./script/httpm.sh start <confiuration file>`.

## Stoping the server

Stop the server by executing `./script/httpm.sh stop`.
Stop the server by executing `./script/httpm.sh stop <configuration file>`.

144 changes: 72 additions & 72 deletions r/httpm.m
Original file line number Diff line number Diff line change
Expand Up @@ -25,74 +25,74 @@
do envconf

; HTTP status codes
set ^httpm("status","100")="Continue"
set ^httpm("status","101")="Switching Protocols"
set ^httpm("status","200")="OK"
set ^httpm("status","201")="Created"
set ^httpm("status","202")="Accepted"
set ^httpm("status","203")="Non-Authoritative Information"
set ^httpm("status","204")="No Content"
set ^httpm("status","205")="Reset Content"
set ^httpm("status","206")="Partial Content"
set ^httpm("status","300")="Multiple Choices"
set ^httpm("status","301")="Moved Permanently"
set ^httpm("status","302")="Found"
set ^httpm("status","303")="See Other"
set ^httpm("status","304")="Not Modified"
set ^httpm("status","305")="Use Proxy"
set ^httpm("status","307")="Temporary Redirect"
set ^httpm("status","400")="Bad Request"
set ^httpm("status","401")="Unauthorized"
set ^httpm("status","402")="Payment Required"
set ^httpm("status","403")="Forbidden"
set ^httpm("status","404")="Not Found"
set ^httpm("status","404","data")="<html><head><title>404 : Page Not Found</title></head><body><h1>404 : Page Not Found</h1></body></html>"
set ^httpm("status","404","ct")="text/html"
set ^httpm("status","404","cl")=$zlength(^httpm("status","404","data"))
set ^httpm("status","405")="Method Not Allowed"
set ^httpm("status","406")="Not Acceptable"
set ^httpm("status","407")="Proxy Authentication Required"
set ^httpm("status","408")="Request Timeout"
set ^httpm("status","409")="Conflict"
set ^httpm("status","410")="Gone"
set ^httpm("status","411")="Length Required"
set ^httpm("status","412")="Precondition Failed"
set ^httpm("status","413")="Request Entity Too Large"
set ^httpm("status","414")="Request-URI Too Long"
set ^httpm("status","415")="Unsupported Media Type"
set ^httpm("status","416")="Requested Range Not Satisfiable"
set ^httpm("status","417")="Expectation Failed"
set ^httpm("status","500")="Internal Server Error"
set ^httpm("status","501")="Not Implemented"
set ^httpm("status","501","data")="<html><head><title>501 : Functionnality Not Implemented</title></head><body><h1>501 : Functionnality Not Implemented</h1></body></html>"
set ^httpm("status","501","ct")="text/html"
set ^httpm("status","501","cl")=$zlength(^httpm("status","501","data"))
set ^httpm("status","502")="Bad Gateway"
set ^httpm("status","503")="Service Unavailable"
set ^httpm("status","504")="Gateway Timeout"
set ^httpm("status","505")="HTTP Version Not Supported"
set ^httpm("status","505","data")="<html><head><title>505 : HTTP Version Not Supported</title></head><body><h1>505 : HTTP Version Not Supported</h1></body></html>"
set ^httpm("status","505","ct")="text/html"
set ^httpm("status","505","cl")=$zlength(^httpm("status","505","data"))
set conf("status","100")="Continue"
set conf("status","101")="Switching Protocols"
set conf("status","200")="OK"
set conf("status","201")="Created"
set conf("status","202")="Accepted"
set conf("status","203")="Non-Authoritative Information"
set conf("status","204")="No Content"
set conf("status","205")="Reset Content"
set conf("status","206")="Partial Content"
set conf("status","300")="Multiple Choices"
set conf("status","301")="Moved Permanently"
set conf("status","302")="Found"
set conf("status","303")="See Other"
set conf("status","304")="Not Modified"
set conf("status","305")="Use Proxy"
set conf("status","307")="Temporary Redirect"
set conf("status","400")="Bad Request"
set conf("status","401")="Unauthorized"
set conf("status","402")="Payment Required"
set conf("status","403")="Forbidden"
set conf("status","404")="Not Found"
set conf("status","404","data")="<html><head><title>404 : Page Not Found</title></head><body><h1>404 : Page Not Found</h1></body></html>"
set conf("status","404","ct")="text/html"
set conf("status","404","cl")=$zlength(conf("status","404","data"))
set conf("status","405")="Method Not Allowed"
set conf("status","406")="Not Acceptable"
set conf("status","407")="Proxy Authentication Required"
set conf("status","408")="Request Timeout"
set conf("status","409")="Conflict"
set conf("status","410")="Gone"
set conf("status","411")="Length Required"
set conf("status","412")="Precondition Failed"
set conf("status","413")="Request Entity Too Large"
set conf("status","414")="Request-URI Too Long"
set conf("status","415")="Unsupported Media Type"
set conf("status","416")="Requested Range Not Satisfiable"
set conf("status","417")="Expectation Failed"
set conf("status","500")="Internal Server Error"
set conf("status","501")="Not Implemented"
set conf("status","501","data")="<html><head><title>501 : Functionnality Not Implemented</title></head><body><h1>501 : Functionnality Not Implemented</h1></body></html>"
set conf("status","501","ct")="text/html"
set conf("status","501","cl")=$zlength(conf("status","501","data"))
set conf("status","502")="Bad Gateway"
set conf("status","503")="Service Unavailable"
set conf("status","504")="Gateway Timeout"
set conf("status","505")="HTTP Version Not Supported"
set conf("status","505","data")="<html><head><title>505 : HTTP Version Not Supported</title></head><body><h1>505 : HTTP Version Not Supported</h1></body></html>"
set conf("status","505","ct")="text/html"
set conf("status","505","cl")=$zlength(conf("status","505","data"))

; Content-types mapping
set ^httpm("ct",".htm")="text/html"
set ^httpm("ct",".html")="text/html"
set ^httpm("ct",".css")="text/css"
set ^httpm("ct",".xml")="text/xml"
set ^httpm("ct",".txt")="text/plain"
set ^httpm("ct",".js")="application/javascript"
set ^httpm("ct",".jpg")="image/jpeg"
set ^httpm("ct",".jpeg")="image/jpeg"
set ^httpm("ct",".gif")="image/gif"
set ^httpm("ct",".png")="image/png"
set conf("ct",".htm")="text/html"
set conf("ct",".html")="text/html"
set conf("ct",".css")="text/css"
set conf("ct",".xml")="text/xml"
set conf("ct",".txt")="text/plain"
set conf("ct",".js")="application/javascript"
set conf("ct",".jpg")="image/jpeg"
set conf("ct",".jpeg")="image/jpeg"
set conf("ct",".gif")="image/gif"
set conf("ct",".png")="image/png"

; Define compressible content-type
set ^httpm("compressible","text/html")=""
set ^httpm("compressible","text/css")=""
set ^httpm("compressible","text/xml")=""
set ^httpm("compressible","text/plain")=""
set ^httpm("compressible","application/javascript")=""
set conf("compressible","text/html")=""
set conf("compressible","text/css")=""
set conf("compressible","text/xml")=""
set conf("compressible","text/plain")=""
set conf("compressible","application/javascript")=""

quit

Expand Down Expand Up @@ -149,7 +149,7 @@ set conf("errorlog")=$ztrnlnm("httpm_errorlog","","","","","VALUE")
;
set $ZTRAP="do errhandler^httpm"
new conf
do envconf
do conf
new line,eol,delim,connection
set eol=$char(13)_$char(10)
set delim=$char(10)
Expand All @@ -158,10 +158,10 @@ set conf("errorlog")=$ztrnlnm("httpm_errorlog","","","","","VALUE")
read line:timeout
if $test,'$zeof do
. set $x=0
. set connection("httpver")=$$gethttpver^request(line)
. if connection("httpver")="HTTP/1.1" set connection("connection")="KEEP-ALIVE" do keepalive(line) if 1
. else if connection("httpver")="HTTP/1.0" set connection("connection")="CLOSE" do keepalive(line) if 1
. else if connection("httpver")="" do serve09(line) if 1
. set connection("HTTPVER")=$$gethttpver^request(line)
. if connection("HTTPVER")="HTTP/1.1" set connection("CONNECTION")="KEEP-ALIVE" do keepalive(line) if 1
. else if connection("HTTPVER")="HTTP/1.0" set connection("CONNECTION")="CLOSE" do keepalive(line) if 1
. else if connection("HTTPVER")="" do serve09(line) if 1
. else do senderr^response("505")
quit

Expand Down Expand Up @@ -210,9 +210,9 @@ set request("uri")=$$geturi^request(line)
quit:$zeof

; If the request advertised a body, read it.
if $data(request("CONTENT-LENGTH")) do
if $data(request("headers","CONTENT-LENGTH")) do
. set request("content")=""
. set length=request("CONTENT-LENGTH")
. set length=request("headers","CONTENT-LENGTH")
. use $io:(nodelim)
. for read line#length:timeout quit:'$test quit:$zeof set request("content")=request("content")_line set length=length-$zlength(line) quit:length<1
. use $io:(delim=delim)
Expand All @@ -233,7 +233,7 @@ set request("uri")=$$geturi^request(line)
; Handle keep-alive connections for HTTP/1.0 and HTTP/1.1.
;

for do servesinglereq(line) quit:connection("connection")'="KEEP-ALIVE" read line:timeout quit:'$test quit:$zeof
for do servesinglereq(line) quit:connection("CONNECTION")'="KEEP-ALIVE" read line:timeout quit:'$test quit:$zeof
quit

errhandler()
Expand Down
15 changes: 9 additions & 6 deletions r/request.m
Original file line number Diff line number Diff line change
Expand Up @@ -36,13 +36,16 @@

parsehdrs(line)
;
; Read and parse a request header. Will update 'request' and 'connection'.
; Read and parse a request header. Will update 'request' or 'connection'.
;
new fieldname
set fieldname=$$FUNC^%UCASE($zpiece(line," ",1))
if fieldname="HOST:" set request("host")=$$FUNC^%UCASE($ztranslate($zpiece(line," ",2),$char(13)))
else if fieldname="CONNECTION:" set connection("connection")=$$FUNC^%UCASE($ztranslate($zpiece(line," ",2),$char(13)))
else set request($ztranslate(fieldname,":"))=$ztranslate($zpiece(line," ",2),$char(13))
new fieldname,value
set fieldname=$ztranslate($$FUNC^%UCASE($zpiece(line," ",1)),":")
set value=$ztranslate($zpiece(line," ",2),$char(13))
; Use upper case value for HOST and CONNECTION header field, as those are looked at internally.
set:(fieldname="HOST")!(fieldname="CONNECTION") value=$$FUNC^%UCASE(value)

if fieldname="CONNECTION" set connection(fieldname)=value
else set request("headers",fieldname)=value

quit

16 changes: 8 additions & 8 deletions r/response.m
Original file line number Diff line number Diff line change
Expand Up @@ -25,9 +25,9 @@
new response
set response("status")=status

if $data(^httpm("status",status,"data")) do
. set response("headers","Content-Type")=^httpm("status",status,"ct")
. set response("headers","Content-Length")=^httpm("status",status,"cl")
if $data(conf("status",status,"data")) do
. set response("headers","Content-Type")=conf("status",status,"ct")
. set response("headers","Content-Length")=conf("status",status,"cl")

; Send response headers
do sendresphdr()
Expand All @@ -36,7 +36,7 @@ set response("status")=status
write eol

; Send error data, if any
write:$data(^httpm("status",status,"data")) ^httpm("status",status,"data")
write:$data(conf("status",status,"data")) conf("status",status,"data")

quit

Expand All @@ -46,7 +46,7 @@ set response("status")=status
;

; Send the status line.
write connection("httpver")_" "_response("status")_" "_^httpm("status",response("status"))_eol
write connection("HTTPVER")_" "_response("status")_" "_conf("status",response("status"))_eol

; Send the Server header.
write "Server: "_conf("serverstring")_eol
Expand Down Expand Up @@ -87,12 +87,12 @@ write connection("httpver")_" "_response("status")_" "_^httpm("status",response(
else set file=filename open file:(fixed:wrap:readonly:chset="M")
for use file read line:timeout quit:'$test quit:$zeof do
. use old
. write:connection("httpver")="HTTP/1.1" $$FUNC^%DH($zlength(line),1),eol
. write:connection("HTTPVER")="HTTP/1.1" $$FUNC^%DH($zlength(line),1),eol
. write line
. write:connection("httpver")="HTTP/1.1" eol
. write:connection("HTTPVER")="HTTP/1.1" eol
. set $x=0
close file
use old
write:connection("httpver")="HTTP/1.1" "0",eol,eol
write:connection("HTTPVER")="HTTP/1.1" "0",eol,eol
quit

2 changes: 1 addition & 1 deletion r/routing.m
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,7 @@

new uri,host,handler
set uri=request("uri")
set host=$select($data(request("host")):request("host"),1:"*")
set host=$select($data(request("headers","HOST")):request("headers","HOST"),1:"*")
set:'$data(^httpm("routing",host)) host=$select($data(^httpm("routing","*")):"*",1:"")
; Try to locate a handle fhe requested URI on the requested host.
for i=$zlength(uri,"/"):-1:1 do quit:$data(^httpm("routing",host,uri))
Expand Down
28 changes: 14 additions & 14 deletions r/static.m
Original file line number Diff line number Diff line change
Expand Up @@ -40,7 +40,7 @@ set response("headers","Date")=$zdate(curdate,"DAY, DD MON YEAR 24:60:SS ")
; Get file last modified data, content-length, and md5sum.
set old=$io
set cmd="cmd"
if connection("httpver")'="HTTP/1.1" do
if connection("HTTPVER")'="HTTP/1.1" do
. open cmd:(command="du -b "_file:readonly)::"PIPE"
. use cmd
. read length
Expand All @@ -56,40 +56,40 @@ set response("headers","Date")=$zdate(curdate,"DAY, DD MON YEAR 24:60:SS ")
use old
set lastmod=$$CDN^%H($zextract(buf,6,7)_"/"_$zextract(buf,9,10)_"/"_$zextract(buf,1,4))_","_$$CTN^%H($zextract(buf,12,19))

if $data(request("if-modified-since")) do
if $data(request("headers","IF-MODIFIED-SINCE")) do
. new ifmod
. set ifmod=$$FUNC^%DATE($zextract(request("IF-MODIFIED-SINCE"),6,7)_"/"_$zextract(request("IF-MODIFIED-SINCE"),9,11)_"/"_$zextract(request("IF-MODIFIED-SINCE"),13,16))_","_$$CTN^%H($zextract(request("IF-MODIFIED-SINCE"),18,25))
. set ifmod=$$FUNC^%DATE($zextract(request("headers","IF-MODIFIED-SINCE"),6,7)_"/"_$zextract(request("headers","IF-MODIFIED-SINCE"),9,11)_"/"_$zextract(request("headers","IF-MODIFIED-SINCE"),13,16))_","_$$CTN^%H($zextract(request("headers","IF-MODIFIED-SINCE"),18,25))
. ; If the file's last modification date is older than the if-modified-since date from the request header, send a "304 Not Modified" reponse.
. ; Notice that in case the below condition is false, the else on the next line will be executed.
. if lastmod'>ifmod set response("status")="304"
else if $data(request("IF-NONE-MATCH")),md5sum=request("IF-NONE-MATCH") set response("status")="304"
else if $data(request("headers","IF-NONE-MATCH")),md5sum=request("headers","IF-NONE-MATCH") set response("status")="304"
else set response("status")="200" set:request("method")'="HEAD" response("file")=file

; Get and send content-type
set ext=$zparse(file,"TYPE")
if $zlength(ext),$data(^httpm("ct",ext)) set ct=^httpm("ct",ext)
if $zlength(ext),$data(conf("ct",ext)) set ct=conf("ct",ext)
else set ct="text/plain"
set response("headers","Content-Type")=ct

; Let the client know which compression will be used, if any.
if $data(request("ACCEPT-ENCODING")) do
if $data(request("headers","ACCEPT-ENCODING")) do
. ; Send Vary header
. set response("headers","Vary")="Accept-Encoding"
. if $data(^httpm("compressible",ct)) do
. . set:request("ACCEPT-ENCODING")["compress" response("encoding")="compress"
. . set:request("ACCEPT-ENCODING")["gzip" response("encoding")="gzip"
. if $data(conf("compressible",ct)) do
. . set:request("headers","ACCEPT-ENCODING")["compress" response("encoding")="compress"
. . set:request("headers","ACCEPT-ENCODING")["gzip" response("encoding")="gzip"
. . set:$data(response("encoding")) response("headers","Content-Encoding")=response("encoding")

; Send chunked-encoding for HTTP/1.1, content-length for everyone else
if connection("httpver")="HTTP/1.1" do
if connection("HTTPVER")="HTTP/1.1" do
. new encoding
. set encoding="chunked"
. ; If TE advertise compression and we are not already using it, check if we can and advertise it if used.
. if '$data(response("encoding")),$data(request("TE")) do
. if '$data(response("encoding")),$data(request("headers","TE")) do
. . write "Vary: TE"_eol
. . if $data(^httpm("compressible",ct)) do
. . . set:request("TE")["compress" response("encoding")="compress"
. . . set:request("TE")["gzip" response("encoding")="gzip"
. . if $data(conf("compressible",ct)) do
. . . set:request("headers","TE")["compress" response("encoding")="compress"
. . . set:request("headers","TE")["gzip" response("encoding")="gzip"
. . . set:$data(response("encoding")) encoding=encoding_", "_response("encoding")
. set response("headers","Transfer-Encoding")=encoding
. if 1
Expand Down
10 changes: 7 additions & 3 deletions script/httpm.sh
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,11 @@
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#

configfile="conf/httpm.conf"
if [ "$2" != "" ] ; then
configfile="$2"
else
configfile="conf/httpm.conf"
fi

if [ ! -f $configfile ] ; then
echo "Configuration file does not exist."
Expand All @@ -45,7 +49,7 @@ case "$1" in
echo "$progname is already running."
else
rm -f $pid
echo "Starting $progname at " `date` >> $log
echo "Starting $progname at " `date` " using configfile." >> $log
TZ="Europe/London" nohup $gtm_dist/mumps -run start^httpm < /dev/null >> $log 2>&1 &
echo $! > $pid
fi
Expand All @@ -55,7 +59,7 @@ case "$1" in
checkpid
if [ "0" = "$status" ] ; then
$gtm_dist/mupip stop `cat $pid`
echo "Stopped $progname at " `date` >> $log
echo "Stopped $progname at " `date` " using configfile." >> $log
else
echo "$progname is not running."
fi
Expand Down

0 comments on commit 8997596

Please sign in to comment.