Fixed an issue with server cache. Fixed an issue with 404 responses. …

…Minor refactoring.
shabiel · Jun 6, 2012 · 850c3c5 · 850c3c5
1 parent 2ba5da2
commit 850c3c5
Show file tree

Hide file tree

Showing 7 changed files with 125 additions and 74 deletions.
diff --git a/r/caching.m b/r/caching.m
@@ -22,7 +22,7 @@
 	;
 
 	; Cache only 200 OK
-	quit:response("status")'="200"
+	quit:response("status")'=200
 	new host,uri,ae,te
 	set host=$get(request("headers","HOST"),0)
 	set uri=request("uri")
@@ -58,10 +58,10 @@
 	.	read buf
 	.	close cmd
 	.	set curlastmod=$$CDN^%H($zextract(buf,6,7)_"/"_$zextract(buf,9,10)_"/"_$zextract(buf,1,4))_","_$$CTN^%H($zextract(buf,12,19))
-	.	set:curlastmod]lastmod lastmod=curlastmod
+	.	set:$$isnewer^date(curlastmod,lastmod) lastmod=curlastmod
 	.	set file=$order(^CACHE(host,uri,ae,te,"filelist",file))
 	use old
-	quit:lastmod]^CACHE(host,uri,ae,te,"lastmod") 0
+	quit:$$isnewer^date(lastmod,^CACHE(host,uri,ae,te,"lastmod")) 0
 
 	; Load the response from cache.
 	kill response

diff --git a/r/date.m b/r/date.m
@@ -0,0 +1,41 @@
+	;
+	; httpm
+	; Copyright (C) 2012 Laurent Parenteau <laurent.parenteau@gmail.com>
+	;
+	; This program is free software: you can redistribute it and/or modify
+	; it under the terms of the GNU Affero General Public License as published by
+	; the Free Software Foundation, either version 3 of the License, or
+	; (at your option) any later version.
+	;
+	; This program is distributed in the hope that it will be useful,
+	; but WITHOUT ANY WARRANTY; without even the implied warranty of
+	; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+	; GNU Affero General Public License for more details.
+	;
+	; You should have received a copy of the GNU Affero General Public License
+	; along with this program. If not, see <http://www.gnu.org/licenses/>.
+	;
+
+isolder(a,b)
+	;
+	; Compare two dates in $HOROLOG format, returning 1 if a is older than b, 0 otherwise.
+	;
+	new ha,hb,sa,sb
+	set ha=$zpiece(a,",",1)
+	set hb=$zpiece(b,",",1)
+	set sa=$zpiece(a,",",2)
+	set sb=$zpiece(b,",",2)
+
+	quit $select((ha<hb)!((ha=hb)&(sa<sb)):1,1:0)
+
+isnewer(a,b)
+	;
+	; Compare two dates in $HOROLOG format, returning 1 if a is newer than b, 0 otherwise.
+	;
+	new ha,hb,sa,sb
+	set ha=$zpiece(a,",",1)
+	set hb=$zpiece(b,",",1)
+	set sa=$zpiece(a,",",2)
+	set sb=$zpiece(b,",",2)
+
+	quit $select((ha>hb)!((ha=hb)&(sa>sb)):1,1:0)
diff --git a/r/httpm.m b/r/httpm.m
@@ -26,71 +26,72 @@
 	do setup^routingconf
 
 	; HTTP status codes
-	; 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","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"))
+	; 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",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 conf("ct",".htm")="text/html"
-	set conf("ct",".html")="text/html"
+	set conf("ct",".html")=conf("ct",".htm")
 	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",".jpeg")=conf("ct",".jpg")
 	set conf("ct",".gif")="image/gif"
 	set conf("ct",".png")="image/png"
+	set conf("ct",".ico")="image/vnd.microsoft.icon"
 
 	; Define compressible content-type
-	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")=""
+	set conf("compressible","text/html")=1
+	set conf("compressible","text/css")=1
+	set conf("compressible","text/xml")=1
+	set conf("compressible","text/plain")=1
+	set conf("compressible","application/javascript")=1
 
 	quit
 
@@ -216,7 +217,7 @@ set request("uri")=$$geturi^request(line)
 
 	; Read all request
 	for  read line:timeout quit:'$test  quit:line=$char(13)  quit:$zeof  do parsehdrs^request(line)
-	if ('$test)!($zeof) set response("status")="408"
+	if ('$test)!($zeof) do set^response(408)  if 1
 	else  do
 	.	; If the request advertised a body, read it.
 	.	if $data(request("headers","CONTENT-LENGTH")) do

diff --git a/r/request.m b/r/request.m
@@ -58,7 +58,7 @@
 	; Method is in the supplied list
 	quit:p'="" 1
 	; Method is not in the supplied list
-	set response("status")="405"
+	do set^response(405)
 	quit 0
 
 cacheisvalid(lastmod,etag)
@@ -71,11 +71,11 @@ set response("status")="405"
 
 	new cacheisvalid
 	set cacheisvalid=0
-	if $get(request("headers","IF-NONE-MATCH"))=etag set response("status")="304" set cacheisvalid=1
+	if $get(request("headers","IF-NONE-MATCH"))=etag do set^response(304)  set cacheisvalid=1 if 1
 	else  if $data(request("headers","IF-MODIFIED-SINCE")) do
 	.	new ifmod
 	.	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.
-	.	if lastmod']ifmod set response("status")="304" set cacheisvalid=1
+	.	if $$isolder^date(lastmod,ifmod) do set^response(304)  set cacheisvalid=1
 
 	quit cacheisvalid
diff --git a/r/response.m b/r/response.m
@@ -16,18 +16,28 @@
 	; along with this program. If not, see <http://www.gnu.org/licenses/>.
 	;
 
+set(status)
+	;
+	; Fill the current response with default stuff for the requested status
+	;
+	set response("status")=status
+
+	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")
+	.	set response("content")=conf("status",status,"data")
+
+	quit
+
 senderr(status)
 	;
 	; Send an HTTP error response
 	;
 
 	; Populate the response
 	new response
-	set response("status")=status
 
-	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")
+	do set^response(status)
 
 	; Send response headers
 	do sendresphdr()
@@ -36,7 +46,7 @@ set response("status")=status
 	write eol
 
 	; Send error data, if any
-	write:$data(conf("status",status,"data")) conf("status",status,"data")
+	write:$data(response("content")) response("content")
 
 	; Log request/response
 	set:'$data(response("date")) response("date")=$horolog
@@ -173,6 +183,7 @@ write connection("HTTPVER")_" "_response("status")_" "_conf("status",response("s
 	.	set cmd="encoding"
 	.	if response("encoding")="gzip" set arg=" -f"
 	.	else  set arg=""
+	.	; The exception handling is a workaround required until GTM-7351 gets fixed.
 	.	open cmd:(exception="new dontcare":command=response("encoding")_arg:fixed:wrap)::"PIPE"
 	.	use cmd
 	.	write data

diff --git a/r/static.m b/r/static.m
@@ -54,7 +54,7 @@ set response("lastmod")=$$CDN^%H($zextract(buf,6,7)_"/"_$zextract(buf,9,10)_"/"_
 	set response("filelist",file)=""
 
 	; If the client's cached copy is no valid, answer a 200 OK with for the file.
-	if '$$cacheisvalid^request(response("lastmod"),md5sum) set response("status")="200" set response("file")=file
+	if '$$cacheisvalid^request(response("lastmod"),md5sum) do set^response(200)  set response("file")=file
 
 	; Send Expires header to be 1 day later than current response's date.
 	set expdate=$zpiece(response("date"),",",1)+1_","_$zpiece(response("date"),",",2)
@@ -90,17 +90,15 @@ set response("headers","ETag")=md5sum
 	; If the request is a directory, but is missing the final "/", permanently redirect it to the correct location
 	set d1=$zparse(file,"DIRECTORY")
 	set d2=$zparse(file_"/","DIRECTORY")
-	if (d1'=d2)&(d1'="")&(d2'="") do
-	.	set response("status")="301"
+	if (d1'=d2)&(d1'="")&(d2'="") do  if 1
+	.	do set^response(301)
 	.	set response("headers","Location")=request("uri")_"/"
 	.	set file=""
 	else  do
 	.	; If the requested URI is a directory, use the default file.
 	.	if $zparse(file,"DIRECTORY")=file set file=file_conf("index")
-	.	set dontcare=$zsearch("")
 	.	; If the file doesn't exist, send a 404 not found.
-	.	if ($zsearch(file)="")!($zextract(file,0,$zlength(docroot))'=docroot) do
-	.	.	set response("status")="404"
-	.	.	set file=""
+	.	set dontcare=$zsearch("")
+	.	if ($zsearch(file)="")!($zextract(file,0,$zlength(docroot))'=docroot) do set^response(404)  set file=""
 
 	quit file
diff --git a/r/template.m b/r/template.m
@@ -63,7 +63,7 @@ write response("content")
 
 	; If the client's cached copy is no valid, answer a 200 OK (response("content") is already populated).
 	; Otherwise, kill the content so it is not sent.
-	if '$$cacheisvalid^request(response("lastmod"),md5sum) set response("status")="200"
+	if '$$cacheisvalid^request(response("lastmod"),md5sum) do set^response(200)  if 1
 	else  kill response("content")
 
 	; Send Expires header to be 1 day later than current response's date.
@@ -136,7 +136,7 @@ set response("filelist",file)=""
 	.	.	.	.	new innerlastmod
 	.	.	.	.	set innerlastmod=$$loadcontent(docroot,docroot_value)
 	.	.	.	.	; Update last modified date if that included file is newer than the base file.
-	.	.	.	.	set:innerlastmod]lastmod lastmod=innerlastmod
+	.	.	.	.	set:$$isnewer^date(innerlastmod,lastmod) lastmod=innerlastmod
 	close file
 	use old