[Axiom-developer] axserver patches

[Arthur Ralfs]

Tim,

These patches should make the versions of axserver.spad.pamphlet
and http.lisp on silver the same as what I'm currently working on.

Arthur

--- axserver.spad.pamphlet      2007-10-08 23:28:38.000000000 -0700
+++ axserver.spad.pamphlet.new  2007-10-10 06:50:31.000000000 -0700
@@ -33,181 +33,214 @@
 )abbrev package AXSERV AxiomServer
 AxiomServer: public == private where
 
-  public == with
+ public == with
 
-    axServer: (Integer, SExpression->Void) -> Void
-    multiServ: SExpression -> Void
-    fileserver: SExpression -> Void
-    axget: SExpression -> Void
-    axpost: SExpression -> Void
-
-
-  private == add
-
-    getFile: (SExpression,String) -> Void
-    getCommand: (SExpression,String) -> Void
-    lastStep: () -> String
-    lastType: () -> String
-    formatMessages: String -> String
-    formatMessages1: String -> String
-
-
-    axServer(port:Integer,serverfunc:SExpression->Void):Void ==
-      WriteLine("socketServer")$Lisp
-      s := SiSock(port,serverfunc)$Lisp
-      -- To listen for just one connection and then close the socket
-      -- uncomment i := 0.
-      i:Integer := 1
-      while (i > 0) repeat
-        if not null?(SiListen(s)$Lisp)$SExpression then
-          w := SiAccept(s)$Lisp
-          serverfunc(w)
---        i := 0
-
-    multiServ(s:SExpression):Void ==
-          WriteLine("multiServ")$Lisp
-          headers:String := ""
-          char:String
-          -- read in the http headers
-          while (char := _
-            STRING(READ_-CHAR_-NO_-HANG(s,NIL$Lisp,'EOF)$Lisp)$Lisp) ^= "EOF"_
-             repeat
-              headers := concat [headers,char]
-          sayTeX$Lisp headers
-          StringMatch("([^ ]*)", headers)$Lisp
-          u:UniversalSegment(Integer)
-          u := segment(MatchBeginning(1)$Lisp+1,_
-                              MatchEnd(1)$Lisp)$UniversalSegment(Integer)
-          reqtype:String := headers.u
-          sayTeX$Lisp  concat ["request type: ",reqtype]
-          if  reqtype = "GET" then
-              StringMatch("GET ([^ ]*)",headers)$Lisp
-              u:UniversalSegment(Integer)
-              u := segment(MatchBeginning(1)$Lisp+1,_
-                              MatchEnd(1)$Lisp)$UniversalSegment(Integer)
-              getFile(s,headers.u)
-          if reqtype = "POST" then
-              StringMatch("command=(.*)$",headers)$Lisp
-              u:UniversalSegment(Integer)
-              u := segment(MatchBeginning(1)$Lisp+1,_
-                               MatchEnd(1)$Lisp)$UniversalSegment(Integer)
-              getCommand(s,headers.u)
-
-    getFile(s:SExpression,pathvar:String):Void ==
-        WriteLine("getFile")$Lisp
-        if not null? PATHNAME_-NAME(PATHNAME(pathvar)$Lisp)$Lisp then
-        -- display contents of file
-            q:=OPEN(pathvar)$Lisp
-        else
-            q:=MAKE_-STRING_-INPUT_-STREAM("Problem with file path")$Lisp
-        file:String := ""
-        while (line :=STRING(READ_-LINE(q,NIL$Lisp,'EOF)$Lisp)$Lisp) ^= "EOF" _
-          repeat
-            file := concat [file,line,STRING(NewLine$Lisp)$Lisp]
-        CLOSE(q)$Lisp
-        file := concat _
-          ["Content-Length: ",string(#file),STRING(NewLine$Lisp)$Lisp,_
-            STRING(NewLine$Lisp)$Lisp,file]
-        file := concat ["Connection: close",STRING(NewLine$Lisp)$Lisp,file]
-        file := concat _
-         ["Content-Type: application/xhtml+xml",STRING(NewLine$Lisp)$Lisp,file]
-        file := concat ["HTTP/1.1 200 OK",STRING(NewLine$Lisp)$Lisp,file]
-        f:=MAKE_-STRING_-INPUT_-STREAM(file)$Lisp
-        SiCopyStream(f,s)$Lisp
-        CLOSE(f)$Lisp
-        CLOSE(s)$Lisp
-
-    getCommand(s:SExpression,command:String):Void ==
-        WriteLine$Lisp concat ["getCommand: ",command]
-        SETQ(tmpmathml$Lisp, MAKE_-STRING_-OUTPUT_-STREAM()$Lisp)$Lisp
-        SETQ(tmpalgebra$Lisp, MAKE_-STRING_-OUTPUT_-STREAM()$Lisp)$Lisp
-        SETQ(savemathml$Lisp, _$texOutputStream$Lisp)$Lisp
-        SETQ(savealgebra$Lisp, _$algebraOutputStream$Lisp)$Lisp
-        SETQ(_$texOutputStream$Lisp,tmpmathml$Lisp)$Lisp
-        SETQ(_$algebraOutputStream$Lisp,tmpalgebra$Lisp)$Lisp
+   axServer: (Integer, SExpression->Void) -> Void
+   multiServ: SExpression -> Void
+
+ private == add
+
+   getFile: (SExpression,String) -> Void
+   getCommand: (SExpression,String) -> Void
+   lastStep: () -> String
+   lastType: () -> String
+   formatMessages: String -> String
+   getContentType: String -> String
+
+
+   axServer(port:Integer,serverfunc:SExpression->Void):Void ==
+     WriteLine("socketServer")$Lisp
+     s := SiSock(port,serverfunc)$Lisp
+     -- To listen for just one connection and then close the socket
+     -- uncomment i := 0.
+     i:Integer := 1
+     while (i > 0) repeat
+       if not null?(SiListen(s)$Lisp)$SExpression then
+         w := SiAccept(s)$Lisp
+         serverfunc(w)
+--         i := 0
+
+   multiServ(s:SExpression):Void ==
+         WriteLine("multiServ begin")$Lisp
+         headers:String := ""
+         char:String
+         -- read in the http headers
+         while (char := 
STRING(READ_-CHAR_-NO_-HANG(s,NIL$Lisp,'EOF)$Lisp)$Lisp) ^= "EOF" repeat
+             headers := concat [headers,char]
+        WriteLine(headers)$Lisp
+         StringMatch("([^ ]*)", headers)$Lisp
+         u:UniversalSegment(Integer)
+         u := 
segment(MatchBeginning(1)$Lisp+1,MatchEnd(1)$Lisp)$UniversalSegment(Integer)
+         reqtype:String := headers.u
+         WriteLine$Lisp  concat ["request type: ",reqtype]
+         if  reqtype = "GET" then
+             StringMatch("GET ([^ ]*)",headers)$Lisp
+             u:UniversalSegment(Integer)
+             u := 
segment(MatchBeginning(1)$Lisp+1,MatchEnd(1)$Lisp)$UniversalSegment(Integer)
+             getFile(s,headers.u)
+         if reqtype = "POST" then
+             StringMatch("command=(.*)$",headers)$Lisp
+             u:UniversalSegment(Integer)
+             u := 
segment(MatchBeginning(1)$Lisp+1,MatchEnd(1)$Lisp)$UniversalSegment(Integer)
+             getCommand(s,headers.u)
+         WriteLine("multiServ end")$Lisp
+        WriteLine("")$Lisp
+
+   getFile(s:SExpression,pathvar:String):Void ==
+       WriteLine("")$Lisp
+       WriteLine("getFile begin")$Lisp
+       if not null? PATHNAME_-NAME(PATHNAME(pathvar)$Lisp)$Lisp then
+           contentType:String := getContentType(pathvar)
+          q := Open(pathvar)$Lisp
+          if null? q then
+            q := MAKE_-STRING_-INPUT_-STREAM("File doesn't exist")$Lisp
+            WriteLine("File does not exist.")$Lisp
+--           if null? (q := Open(pathvar)$Lisp) then
+--          q := MAKE_-STRING_-INPUT_-STREAM("File doesn't exist")$Lisp
+       else
+           q:=MAKE_-STRING_-INPUT_-STREAM("Problem with file path")$Lisp
+       file:String := ""
+       WriteLine("begin reading file")$Lisp
+       r := MAKE_-STRING_-OUTPUT_-STREAM()$Lisp
+       SiCopyStream(q,r)$Lisp
+       filestream:String := GET_-OUTPUT_-STREAM_-STRING(r)$Lisp
+       CLOSE(r)$Lisp
+       CLOSE(q)$Lisp
+       filelength:String := string(#filestream)
+       WriteLine("end reading file")$Lisp
+       file := concat ["Content-Length: 
",filelength,STRING(NewLine$Lisp)$Lisp,STRING(NewLine$Lisp)$Lisp,file]
+       file := concat ["Connection: close",STRING(NewLine$Lisp)$Lisp,file]
+       file := concat ["Content-Type: 
",contentType,STRING(NewLine$Lisp)$Lisp,file]
+       file := concat ["HTTP/1.1 200 OK",STRING(NewLine$Lisp)$Lisp,file]
+       file := concat [file,filestream]
+       f:=MAKE_-STRING_-INPUT_-STREAM(file)$Lisp
+       SiCopyStream(f,s)$Lisp
+       CLOSE(f)$Lisp
+       CLOSE(s)$Lisp
+       WriteLine("getFile end")$Lisp
+       WriteLine("")$Lisp
+
+   getCommand(s:SExpression,command:String):Void ==
+       WriteLine$Lisp concat ["getCommand: ",command]
+       SETQ(tmpmathml$Lisp, MAKE_-STRING_-OUTPUT_-STREAM()$Lisp)$Lisp
+       SETQ(tmpalgebra$Lisp, MAKE_-STRING_-OUTPUT_-STREAM()$Lisp)$Lisp
+       SETQ(savemathml$Lisp, _$texOutputStream$Lisp)$Lisp
+       SETQ(savealgebra$Lisp, _$algebraOutputStream$Lisp)$Lisp
+       SETQ(_$texOutputStream$Lisp,tmpmathml$Lisp)$Lisp
+       SETQ(_$algebraOutputStream$Lisp,tmpalgebra$Lisp)$Lisp
 --      parseAndInterpret$Lisp command
 --      parseAndEvalStr$Lisp command
--- The previous two commands don't exit nicely when a syntactically 
--- incorrect command is given to them. They somehow need to be wrapped 
--- in CATCH statements but I haven't figured out how to do this.  
--- parseAndEvalToStringEqNum  uses the following CATCH statements to 
--- call parseAndEvalStr but when I try these they don't work.  I get a
--- "NIL is not a valid identifier to use in AXIOM" message. 
--- Using parseAndEvalToStringEqNum works and doesn't crash on a syntax error.
---        v := CATCH('SPAD__READER, _
-           CATCH('top__level, parseAndEvalStr$Lisp command)$Lisp)$Lisp
+-- The previous two commands don't exit nicely when a syntactically incorrect 
command is
+-- given to them.  They somehow need to be wrapped in CATCH statements but I 
haven't
+-- figured out how to do this.  parseAndEvalToStringEqNum  uses the following 
CATCH
+-- statements to call parseAndEvalStr but when I try these they don't work.  I 
get a
+-- "NIL is not a valid identifier to use in AXIOM" message. Using 
parseAndEvalToStringEqNum
+-- works and doesn't crash on a syntax error.
+--        v := CATCH('SPAD__READER, CATCH('top__level, parseAndEvalStr$Lisp 
command)$Lisp)$Lisp
 --        v = 'restart => ['"error"]
-        ans := string parseAndEvalToStringEqNum$Lisp command
-        SETQ(resultmathml$Lisp,_
-         GET_-OUTPUT_-STREAM_-STRING(_$texOutputStream$Lisp)$Lisp)$Lisp
-        SETQ(resultalgebra$Lisp,_
-         GET_-OUTPUT_-STREAM_-STRING(_$algebraOutputStream$Lisp)$Lisp)$Lisp
-        SETQ(_$texOutputStream$Lisp,savemathml$Lisp)$Lisp
-        SETQ(_$algebraOutputStream$Lisp,savealgebra$Lisp)$Lisp
-        CLOSE(tmpmathml$Lisp)$Lisp
-        CLOSE(tmpalgebra$Lisp)$Lisp
-        -- Since strings returned from axiom are going to be displayed in html
-        -- I should really check for the characters &,<,> and replace them with
-        -- &amp;,&lt;,&gt;.  
-        -- At present I only check for ampersands in formatMessages.
-        mathml:String := string(resultmathml$Lisp)
-        algebra:String := string(resultalgebra$Lisp)
-        algebra := formatMessages(algebra)
-        -- At this point mathml contains the mathml for the output but does 
-        -- not include step number or type information.  We should also save 
-        -- the command. I get the type and step number from the 
-        -- $internalHistoryTable
-        axans:String := concat 
-         ["<div>"_
-           "<div class=_"stepnum_"> (", lastStep(), _
-              ") -&gt; ", command, "</div>" _
-           "<div class=_"algebra_">", algebra, "</div>" _
-           "<div id=_"answer_" class=_"mathml_">", mathml , "</div>" _
-           "<div class=_"type_">Type: ",lastType(),"</div>"_
-          "</div>"]
-        WriteLine$Lisp concat ["mathml answer: ",mathml]
-        WriteLine$Lisp concat ["algebra answer: ",algebra]
-        q:=MAKE_-STRING_-INPUT_-STREAM(axans)$Lisp
-        SiCopyStream(q,s)$Lisp
-        CLOSE(q)$Lisp
-        CLOSE(s)$Lisp
+       ans := string parseAndEvalToStringEqNum$Lisp command
+       
SETQ(resultmathml$Lisp,GET_-OUTPUT_-STREAM_-STRING(_$texOutputStream$Lisp)$Lisp)$Lisp
+       
SETQ(resultalgebra$Lisp,GET_-OUTPUT_-STREAM_-STRING(_$algebraOutputStream$Lisp)$Lisp)$Lisp
+       SETQ(_$texOutputStream$Lisp,savemathml$Lisp)$Lisp
+       SETQ(_$algebraOutputStream$Lisp,savealgebra$Lisp)$Lisp
+       CLOSE(tmpmathml$Lisp)$Lisp
+       CLOSE(tmpalgebra$Lisp)$Lisp
+       -- Since strings returned from axiom are going to be 
+       -- displayed in html I
+       -- should really check for the characters &,<,> and 
+       -- replace them with
+       -- &amp;,&lt;,&gt;.  At present I only check for ampersands in
+       -- formatMessages.  MathML should already be valid xml.
+       mathml:String := string(resultmathml$Lisp)
+       algebra:String := string(resultalgebra$Lisp)
+       algebra := formatMessages(algebra)
+       -- At this point mathml contains the mathml for the 
+       -- output but does not
+       -- include step number or type information.  
+       -- We should also save the command.
+       -- I get the type and step number from the $internalHistoryTable
+       axans:String := concat ["<div><div class=_"command_">(",lastStep(),") 
-> ",command,"</div><div class=_"algebra_">",algebra,"</div><div 
class=_"mathml_">",mathml,"</div><div class=_"type_">Type: 
",lastType(),"</div></div>"]
+       WriteLine$Lisp concat ["mathml answer: ",mathml]
+       WriteLine$Lisp concat ["algebra answer: ",algebra]
+       q:=MAKE_-STRING_-INPUT_-STREAM(axans)$Lisp
+       SiCopyStream(q,s)$Lisp
+       CLOSE(q)$Lisp
+       CLOSE(s)$Lisp
 
-    lastType():String ==
+
+   lastType():String ==
 --  The last history entry is the first item in the 
---  $internalHistoryTable list so car(_$internalHistoryTable$Lisp) 
---  selects it.  Here's an example:
---  (3 (x+y)**3 (% (value (Polynomial (Integer)) WRAPPED 1 y 
---   (3 0 . 1) (2 1 x (1 0 . 3)) (1 1 x (2 0 . 3)) (0 1 x (3 0 . 1)))))
---  This corresponds to the input "(x+y)**3" being issued as the third 
---  command after starting axiom. 
---  The following line selects the type information.
-        string cadr(cadar(cddar(_$internalHistoryTable$Lisp)$Lisp)$Lisp)$Lisp
-
-    lastStep():String == 
-        string caar(_$internalHistoryTable$Lisp)$Lisp
-
-    formatMessages(str:String):String ==
-        WriteLine("formatMessages")$Lisp
-        -- I need to replace any ampersands with &amp; and may also need to
-        -- replace < and > with &lt; and &gt;
-        strlist:List String
-        WriteLine(str)$Lisp
-        strlist := split(str,char "&")
-        str := ""
-        for s in strlist repeat
-            str := concat [str,s,"&amp;"]
-        strlen:Integer := #str
-        str := str.(1..(#str - 5))
-        WriteLine(str)$Lisp
-        -- Here I split the string into lines and put each line in a "div".
-        strlist := split(str, char string NewlineChar$Lisp)
-        str := ""
-        WriteLine("formatMessages1")$Lisp
-        WriteLine(concat strlist)$Lisp
-        for s in strlist repeat
-            WriteLine(s)$Lisp
-            str := concat [str,"<div>",s,"</div>"]
-        str
+-- $internalHistoryTable list so
+--  car(_$internalHistoryTable$Lisp) selects it.  Here's an example:
+--  (3 (x+y)**3 (% (value (Polynomial (Integer)) WRAPPED 1 y (3 0 . 1) (2 1 x 
(1 0 . 3)) (1 1 x (2 0 . 3)) (0 1 x (3 0 . 1)))))
+--  This corresponds to the input "(x+y)**3" being issued 
+-- as the third command after
+--  starting axiom.  The following line selects the type information.
+       string 
car(cdr(car(cdr(car(cdr(cdr(car(_$internalHistoryTable$Lisp)$Lisp)$Lisp)$Lisp)$Lisp)$Lisp)$Lisp)$Lisp)$Lisp
+
+
+   lastStep():String ==
+       string car(car(_$internalHistoryTable$Lisp)$Lisp)$Lisp
+
+
+   formatMessages(str:String):String ==
+       WriteLine("formatMessages")$Lisp
+       -- I need to replace any ampersands with &amp; and may also need to
+       -- replace < and > with &lt; and &gt;
+       strlist:List String
+       WriteLine(str)$Lisp
+       strlist := split(str,char "&")
+       str := ""
+       -- oops, if & is the last character in the string this method
+       -- will eliminate it.  Need to redo this.
+       for s in strlist repeat
+           str := concat [str,s,"&amp;"]
+       strlen:Integer := #str
+       str := str.(1..(#str - 5))
+       WriteLine(str)$Lisp
+       -- Here I split the string into lines and put each line in a "div".
+       strlist := split(str, char string NewlineChar$Lisp)
+       str := ""
+       WriteLine("formatMessages1")$Lisp
+       WriteLine(concat strlist)$Lisp
+       for s in strlist repeat
+           WriteLine(s)$Lisp
+           str := concat [str,"<div>",s,"</div>"]
+       str
+
+   getContentType(pathvar:String):String ==
+       WriteLine("getContentType begin")$Lisp
+       -- set default content type
+       contentType:String := "text/plain"
+       -- need to test for successful match?
+       StringMatch(".*\.(.*)$", pathvar)$Lisp
+       u:UniversalSegment(Integer)
+       u := 
segment(MatchBeginning(1)$Lisp+1,MatchEnd(1)$Lisp)$UniversalSegment(Integer)
+       extension:String := pathvar.u
+       WriteLine$Lisp concat ["file extension: ",extension]
+       -- test for extensions: html, htm, xml, xhtml, js, css, png, jpg, jpeg
+       if extension = "html" then
+           contentType:String := "text/html"
+       else if extension = "htm" then
+           contentType:String := "text/html"
+       else if extension = "xml" then
+           contentType:String := "text/xml"
+       else if extension = "xhtml" then
+           contentType:String := "application/xhtml+xml"
+       else if extension = "js" then
+           contentType:String := "text/javascript"
+       else if extension = "css" then
+           contentType:String := "text/css"
+       else if extension = "png" then
+           contentType:String := "image/png"
+       else if extension = "jpg" then
+           contentType:String := "image/jpeg"
+       else if extension = "jpeg" then
+           contentType:String := "image/jpeg"
+       WriteLine$Lisp concat ["Content-Type: ",contentType]
+       WriteLine("getContentType end")$Lisp
+       contentType
+
 
 
 @
@@ -229,9 +262,9 @@
 --      the documentation and/or other materials provided with the
 --      distribution.
 --
---    - Neither the name of Arthur C. Ralfs nor the
---      names of its contributors may be used to endorse or promote products
---      derived from this software without specific prior written permission.
+--    - The name of Arthur C. Ralfs may not be used to endorse or promote 
+--      products derived from this software without specific prior written 
+--      permission.
 --
 --THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
 --IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

--- http.lisp   2007-10-08 23:28:41.000000000 -0700
+++ http.lisp.new       2007-10-10 06:30:45.000000000 -0700
@@ -1,6 +1,9 @@
 (in-package "BOOT")
 
-(defvar |StandardOutput| *standard-output*)
+(defun |Open| (path)
+  (si::open path :direction :input :if-exists nil :if-does-not-exist nil)
+  )
+
 
 (defvar  |NewLine| '#\NewLine)