/* HTTP server 1.0 - May 1999 - by Vincent CARON */ /* correction iri - october 03 */ typeof http_svr =HTTPserver;; typeof http_url =S;; /* requested url */ typeof http_path =S;; /* requested file path */ typeof http_cgi =S;; /* CGI parameters (GET & POST) */ typeof http_com =S;; /* HTTP command */ typeof http_len =I;; /* post data bytes counter */ typeof http_host =S;; /* host name */ typeof http_port = I;; var http_id ="SCOL HTTP server plugin v1.0";; var http_root ="";; var http_err ="/error/code";; typeof CONlist = [[HTTPcon S] r1];; /* AJOUT PAR DAV. */ var HTTP_DEFAULT="index.html";; var MIME_TYPES=["htm" "text/html"]::["html" "text/html"]:: ["gif" "image/gif"]:: ["jpg" "image/jpeg"]:: ["png" "image/png"]:: ["txt" "text/plain"]:: ["mpg" "video/mpeg"]:: ["mpeg" "video/mpeg"]:: ["avi" "video/x-ms-video"]:: ["mov" "video/quicktime"]:: ["au" "audio/basic"]:: ["wav" "audio/x-wav"]:: ["mid" "audio/mid"]:: ["mp3" "audio/x-mpeg"]:: ["ra" "audio/x-pn-realaudio"]:: ["ram" "audio/x-pn-realaudio"]::nil;; fun file_extension(fname)= let strfind "." fname 0 -> pos in if (pos==nil) then nil else substr fname pos+1 (strlen fname)-pos-1;; fun http_codestr(code)= if (code==200) then "OK" else if (code==301) then "Moved permanently" else if (code==302) then "Moved temporarily" else if (code==400) then "Bad request" else if (code==404) then "Not found" else if (code==501) then "Not implemented" else "";; fun _mimetype(l,ext)= if (l==nil) then "application/x-unknown" else let l -> [_head _tail] in let _head -> [lext ltype] in if (!strcmpi ext lext) then ltype else _mimetype _tail ext;; fun mimetype(fname)= _mimetype MIME_TYPES file_extension fname;; /* compose the HTTP answer header */ fun http_header(code,data)= strcatn "HTTP/1.0 "::(itoa code)::" "::(http_codestr code)::"\13\10":: "Server: "::http_id::"\13\10":: { if ((code==301) || (code==302)) then strcat "Location: " http_url else strcatn "Content-Type: "::(mimetype http_path)::"\13\10":: "Content-Length: "::(itoa strlen data)::nil; } ::"\13\10\13\10"::nil;; /* returns HTTP error with HTML code if available */ fun http_error(code)= set http_path=strcatn http_root::http_err::(itoa code)::".html"::nil; let _getpack _checkpack http_path -> html in strcat (http_header code html) html;; /* the main job ! */ fun http_fetch()= set http_path=strcat http_root http_url; let _checkpack http_path -> file in { if (file==nil) then { /* maybe a folder ? */ set file=_checkpack (strcatn http_path::"/"::HTTP_DEFAULT::nil); if (file==nil) then /* nope, so file not found */ http_error 404 else { /* yep, this is a folder, send redirection to browser */ set http_url=strcat http_url "/"; http_header 302 nil; } } else /* retrieve file */ let _getpack file -> data in strcat (http_header 200 data) data; };; /* parse "COMMAND url HTTP/1.x", check URL. */ fun http_parse_command(words)= let words -> [com x] in let x -> [url x] in /* let x -> [ver _] in ... (unused) */ { set http_com=com; if ((nth_char url 0)=='/) then nil else if (!strcmpi (substr url 0 7) "http://") then { /* url is (incorrectly) "http://mysite[/path]" */ let strfind "/" url 7 -> pos in if (pos==nil) then set url="/" else set url=substr url pos (strlen url)-pos; } else /* invalid URL */ set url=nil; /* search for cgi params */ let strfind "?" url 0 -> pos in if (pos==nil) then set http_url=url else { set http_url=substr url 0 pos; set http_cgi=substr url (pos+1) (strlen url)-pos-1; }; /* append default file name if folder */ if ((nth_char http_url (strlen http_url)-1)=='/) then set http_url=strcat http_url HTTP_DEFAULT else nil; };; /* parse the "param: value" lines */ fun http_parse_header(lines)= let lines -> [_head _tail] in if (_head==nil) then 0 else let _head -> [param x] in let linebuild x -> value in { if (!strcmpi param "Content-Length:") then set http_len=atoi value else if (!strcmpi param "Host:") then {set http_host=value; 0} else 0; http_parse_header _tail; };; /* get the POST data bytes (after header) */ fun http_readpost(req)= let strfind "\13\10\13\10" req 0 -> pos in if (pos==nil) then set http_cgi="" else set http_cgi=substr req (pos+4) http_len;; /* --------------------- */ /* ZONE D'AJOUT PAR DAV. */ /* --------------------- */ fun eqPos1(a,b)= let a -> [c _] in b==c ;; fun strcmpPos2(a,b)= let a -> [_ c] in !strcmp b c ;; fun closing(con,x)= set CONlist = removef_from_list CONlist @eqPos1 con; /* suppression d'une connexion de la liste des connectes */ _fooS "close HTTPserver connection" ;; fun giveID (list,id)= if list==nil then strcatn id::"-1"::nil else let hd list -> [_ ID] in let strlen id -> lg in let strfind "-" ID lg -> pos in if (pos==lg) && (!strcmp id substr ID 0 lg) then let strlen ID -> lg in let atoi substr ID pos+1 lg-pos-1 -> nb in strcatn id::"-"::(itoa nb+1)::nil else giveID (tl list) id ;; fun addToCONList (con)= let search_in_list CONlist @eqPos1 con -> connection in if connection==nil then /* Pas ds la liste */ let (giveID CONlist itoa time) -> SessionID in ( set CONlist=[con SessionID]::CONlist; /* => ajout */ SessionID ) else let connection -> [_ SessionID] in SessionID ;; fun http_Dynamic (con) = rflHTTPclose con @closing nil; let addToCONList con -> SessionID in _DMSevent this nil "cgi" strbuild ("SessionID"::SessionID::nil):: ("http_url"::http_url::nil):: ("http_cgi"::http_cgi::nil):: nil "cgiAnswer" ;; /* TMP */ fun _foosCONlist (list) = if list==nil then _fooS "SessionId : end List" else ( let hd list -> [_ foo] in _fooS strcat "SessionId : " foo; _foosCONlist tl list ) ;; /* ---------------------------- */ /* FIN DE ZONE D'AJOUT PAR DAV. */ /* ---------------------------- */ /* HTTPserver reflex */ fun http_onrequest(con,x,req)= /* _fooS strcat "HTTP request from " (getHTTPclientIP con); */ /* let getHTTPstats http_svr -> [_cnb _in _out] in _fooS strcatn "stats: "::(itoa _cnb)::" "::(itoa _in)::" "::(itoa _out)::nil; */ set http_cgi=""; set http_len=0; let strextr req -> lines in { http_parse_command hd lines; if ((!strcmpi http_com "GET") || (!strcmpi http_com "POST")) then { if (http_url==nil) then http_error 400 else { http_parse_header tl lines; if ((!strcmpi http_com "POST") && (http_len>0)) then http_readpost req else nil; /* from here, fetch the file */ /*_DLGrflmessage (_DLGMessageBox _channel nil "HTTP variables" strcatn "http_url= "::http_url::"\nhttp_path= "::http_path::"\nhttp_cgi= "::http_cgi::"\nhttp_com= "::http_com::"\nhttp_host= "::http_host::nil 0) nil 0;*/ if (strfind ".scolcgi" http_url 0)!=nil then ( /* Page a generer a la volee (AJOUT PAR DAV.) */ http_Dynamic con; nil ) else http_fetch; }; } else /* unknown command */ http_error 501; };; /* appends the "http://IP[:port]" to a HTTP path */ fun http_filter(url)= strcatn "http://"::_hostIP:: (if (http_port!=80) then strcat ":" (itoa http_port) else "")::"/":: /* iri : add ' "/":: ' */ url::nil;; /* ----- DMS code ----- */ fun getparam(l)= if (l==nil) then 0 else let l -> [line _tail] in { let line -> [param x] in let x -> [value _] in if (!strcmpi param "HTTPport") then set http_port=atoi value else if (!strcmpi param "HTTProot") then {set http_root=value; 0} else 0; getparam _tail; };; fun server_close()= let getHTTPstats http_svr -> [_cnb _in _out] in _fooS strcatn "HTTP server statitics :\n":: " connections: "::(itoa _cnb)::"\n":: " input : "::(itoa _in)::" bytes\n":: " output: "::(itoa _out)::" bytes"::nil; closeHTTPserver http_svr; 0;; fun activate(from,cli,action,param,rep)= if (!strcmpi action "url_in") then _DMSevent this cli "url_out" (http_filter param) nil else if (!strcmpi action "cgiAnswer") then /* AJOUT PAR DAV. */ let strextr param -> paramList in let getInfo paramList "SessionID" -> SessionID in let getInfo paramList "Page" -> Page in let search_in_list CONlist @strcmpPos2 SessionID -> [_con _] in ( _foosCONlist CONlist; if Page==nil then ( closeHTTPcon _con /* fermeture de la connexion si contenu de page vide */ ;_fooS "closeHTTPcon";nil ) else if (strfindi "Error" Page 0)==3 then ( let HTTPsend _con http_error atoi (substr Page 5 8) -> res in _fooS strcat "HTTPsend : " (itoa res);nil ) else ( let HTTPsend _con Page -> res in _fooS strcat "HTTPsend : " (itoa res);nil ) ;_foosCONlist CONlist;nil ) else nil;; fun IniDMI(fname)= /*_showconsole;*/ let strextr _getpack _checkpack fname -> lines in getparam lines; /* iri - below : http_port -> I ; strcmp expect S, so add itoa function */ if (http_port == nil) || (!strcmp itoa http_port "") then set http_port = DMSport + 2 else nil; /* strip out any terminating slash */ let (strlen http_root)-1 -> last in if ((nth_char http_root last)=='/) then set http_root=substr http_root 0 last else nil; /* start server */ set http_svr=startHTTPserver _channel http_port @http_onrequest nil; _DMSregisterDMI this @activate nil nil @server_close;;