Edit detail for AxServer revision 3 of 3
| 1 2 3 | ||
|
Editor: alfredo
Time: 2008/03/16 21:22:01 GMT-7 |
||
| Note: | ||
changed: - (si::open path :direction :input :if-exists nil :if-does-not-exist nil) - ) (si::open path :direction :input :if-exists nil :if-does-not-exist nil) ) added: (defun |WriteLine| (string &optional (outstream *standard-output*)) (write-line string outstream) (finish-output outstream) ) changed: - (function - (lambda (w) (SPADCALL w spadfn) ) - ) - :daemon nil) - ) (function (lambda (w) (SPADCALL w spadfn) ) ) :daemon nil) ) changed: - ((eq c '#\Space)) - (setq get (concat get (string c))) - ) ((eq c '#\Space)) (setq get (concat get (string c))) ) changed: - ((eq c '#\Space)) - (setq pathvar (concat pathvar (string c))) - ) ((eq c '#\Space)) (setq pathvar (concat pathvar (string c))) ) changed: - (if (pathname-name (pathname pathvar)) - (with-open-file (q pathvar) (si::copy-stream q s)) - (dolist (l (directory pathvar)) (format s "~a~%" (namestring l))) - ) - ) (if (pathname-name (pathname pathvar)) (with-open-file (q pathvar) (si::copy-stream q s)) (dolist (l (directory pathvar)) (format s "~a~%" (namestring l))) ) ) changed: - (tagbody l - (when (si::listen s) - (let ((w (si::accept s))) - (foo w))) - (sleep 10000) - (go l)))) (tagbody l (when (si::listen s) (let ((w (si::accept s))) (foo w))) (sleep 10000) (go l)))) changed: - axServer: (Integer, SExpression->Void) -> Void - multiServ: SExpression -> Void axServer: (Integer, SExpression->Void) -> Void multiServ: SExpression -> Void changed: - 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) 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) changed: - 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] - 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) - WriteLine("multiServ end")$Lisp - WriteLine("")$Lisp - - getFile(s:SExpression,pathvar:String):Void == - WriteLine("")$Lisp - WriteLine("getFile")$Lisp - if not null? PATHNAME_-NAME(PATHNAME(pathvar)$Lisp)$Lisp then - -- display contents of file - --first determine Content-Type from file extension - 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 - 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 - WriteLine("end reading file")$Lisp - filelength:String := string(#filestream) - 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 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" and char ^= "NIL" repeat -- WriteLine$Lisp "multiServ while"char headers := concat [headers,char] WriteLine$Lisp headers 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")$Lisp if not null? PATHNAME_-NAME(PATHNAME(pathvar)$Lisp)$Lisp then -- display contents of file --first determine Content-Type from file extension 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 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 WriteLine("end reading file")$Lisp filelength:String := string(#filestream) 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 changed: - 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 - -- &,<,>. 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 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 -- &,<,>. 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 changed: - axans:String := concat ["<div class=_"stepnum_">", lastStep(), "</div><div class=_"command_">", command, "</div><div class=_"algebra_">",algebra,"</div><div class=_"mathml_">",mathml,"</div><div class=_"type_">",lastType(),"</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 == --- 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 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 & and may also need to - -- replace < and > with < and > - 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,"&"] - 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 - 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 - axans:String := concat ["<div class=_"stepnum_">", lastStep(), "</div><div class=_"command_">", command, "</div><div class=_"algebra_">",algebra,"</div><div class=_"mathml_">",mathml,"</div><div class=_"type_">",lastType(),"</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 == -- to examine the $internalHistoryTable uncomment the following lines WriteLine$Lisp "lastType begin" -- WriteLine$Lisp string _$internalHistoryTable$Lisp -- need to pick out first member of internalHistoryTable and then pick out -- the element with % as first element, here's an example showing just -- the first element of the list, which correponds to the last command. -- Note that the last command does not necessarily correspond to the last -- element of the first element of $internalHistoryTable as it is in this -- example. --( -- (4 NIL -- (x (value (BasicOperator) WRAPPED . #<vector 09a93bd0>)) -- (y (value (BasicOperator) WRAPPED . #<vector 09a93bb4>)) -- (% (value (Matrix (Polynomial (Integer))) WRAPPED . #<vector 0982e0e0>)) -- ) --... --) -- Also need to check for input error in which case the $internalHistoryTable -- is not changed and the type retrieved would be that for the last correct -- input. SETQ(first$Lisp,FIRST(_$internalHistoryTable$Lisp)$Lisp)$Lisp count:Integer := 0 hisLength:Integer := LIST_-LENGTH(_$internalHistoryTable$Lisp)$Lisp length:Integer := LIST_-LENGTH(first$Lisp)$Lisp -- This initializes stepSav. The test is a bit of a hack, maybe I'll -- figure out the right way to do it later. if string stepSav$Lisp = "#<OBJNULL>" then SETQ(stepSav$Lisp, 0$Lisp)$Lisp -- If hisLength = 0 then the history table has been reset to NIL -- and we're starting numbering over if hisLength = 0 then SETQ(stepSav$Lisp, 0$Lisp)$Lisp if hisLength > 0 and CAR(CAR(_$internalHistoryTable$Lisp)$Lisp)$Lisp ^= stepSav$Lisp then SETQ(stepSav$Lisp, CAR(CAR(_$internalHistoryTable$Lisp)$Lisp)$Lisp)$Lisp while count < length repeat position(char "%",string FIRST(first$Lisp)$Lisp) = 2 => count := length+1 count := count +1 SETQ(first$Lisp,REST(first$Lisp)$Lisp)$Lisp count = length + 1 => string SECOND(SECOND(FIRST(first$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 & and may also need to -- replace < and > with < and > strlist:List String WriteLine$Lisp "formatMessages1" 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,"&"] strlen:Integer := #str str := str.(1..(#str - 5)) WriteLine$Lisp "formatMessages2" -- WriteLine(str)$Lisp -- Here I split the string into lines and put each line in a "div". WriteLine$Lisp "formatMessages2.1" strlist := split(str, char string NewLine$Lisp) WriteLine$Lisp "formatMessages3" str := "" WriteLine("formatMessages4")$Lisp WriteLine(concat strlist)$Lisp for s in strlist repeat WriteLine(s)$Lisp str := concat [str,"<div>",s,"</div>"] WriteLine("formatMessages5")$Lisp 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 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
