diff --git a/Http/Examples/example.icl b/Http/Examples/example.icl index 540c91540e98b9f4d7e027c106501f4899438a3f..7a21749b33a475409f49b7c1ea3da218e1fe96ec 100644 --- a/Http/Examples/example.icl +++ b/Http/Examples/example.icl @@ -1,10 +1,12 @@ module example -import Http, HttpServer, HttpCGI, HttpUtil +import Http, HttpServer, HttpCGI, HttpUtil, HttpSubServer import StdString, StdList, StdArray, StdInt -//serverFunction = http_startServer -//serverOptions = [HTTPServerOptPort 80, HTTPServerOptStaticFallback True, HTTPServerOptParseArguments True] -serverFunction = http_startCGI -serverOptions = [HTTPCGIOptParseArguments True] +serverFunction = http_startServer +serverOptions = [HTTPServerOptPort 80, HTTPServerOptStaticFallback True, HTTPServerOptParseArguments True] +//serverFunction = http_startCGI +//serverOptions = [HTTPCGIOptParseArguments True] +//serverFunction = http_startSubServer +//serverOptions = [HTTPSubServerOptPort 80, HTTPSubServerOptStaticFallback True, HTTPSubServerOptParseArguments True] Start :: *World -> *World Start world = serverFunction serverOptions [ ((==) "/debug",debug) , ((==) "/upload", upload) diff --git a/Http/HttpCGI.icl b/Http/HttpCGI.icl index 0485a5008f771a0b94bac1cb642119ed75d4ba1c..d18f7067d89083fb84d3ae68516c0af8b6df1cc8 100644 --- a/Http/HttpCGI.icl +++ b/Http/HttpCGI.icl @@ -32,7 +32,7 @@ http_startCGI options handlers world client_name = getClientName} # request = if (getParseOption options) (http_parseArguments request) request - # (response,world) = makeResponse options request handlers world + # (response,world) = http_makeResponse request handlers (getStaticOption options) world # (response,world) = http_encodeResponse response False world # (ok,console) = freopen console FWriteData # console = fwrites response console @@ -67,15 +67,6 @@ makeHeaders [(name,envname):xs] = case value of EnvironmentVariableUndefined = makeHeaders xs (EnvironmentVariable v) = [(name,v): makeHeaders xs] -// Calls the request handler for a request and returns the generated response -makeResponse :: [HTTPCGIOption] HTTPRequest [((String -> Bool),(HTTPRequest *World -> (HTTPResponse, *World)))] *World -> (HTTPResponse, *World) -makeResponse options request [] world //None of the request handlers matched - = if (getStaticOption options) - (http_staticResponse request world) (http_notfoundResponse request world) -makeResponse options request [(pred,handler):rest] world - | (pred request.req_path) = handler request world //Apply handler function - = makeResponse options request rest world //Search the rest of the list - getStaticOption :: [HTTPCGIOption] -> Bool getStaticOption [] = False getStaticOption [x:xs] = case x of (HTTPCGIOptStaticFallback b) = b diff --git a/Http/HttpServer.icl b/Http/HttpServer.icl index 91ee74fad431a90f4aba56a6022bf2b9226435bc..db7f84c53f2e60b6b594d530dfc6009dc97e3b98 100644 --- a/Http/HttpServer.icl +++ b/Http/HttpServer.icl @@ -70,7 +70,7 @@ loop options handlers listener rchannels schannels requests world | method_done && headers_done && data_done # request = if (getParseOption options) (http_parseArguments request) request // Create a response - # (response,world) = makeResponse options request handlers world + # (response,world) = http_makeResponse request handlers (getStaticOption options)world // Encode the response to the HTTP protocol format # (reply, world) = http_encodeResponse response True world // Send the encoded response to the client @@ -124,15 +124,6 @@ addRequestData req requestline_done headers_done data_done data = (req,True,True,True,False) //We have all data and are done //Data is added while we were already done = (req,True,True,True,False) - -// Calls the request handler for a request and returns the generated response -makeResponse :: [HTTPServerOption] HTTPRequest [((String -> Bool),(HTTPRequest *World -> (HTTPResponse, *World)))] *World -> (HTTPResponse, *World) -makeResponse options request [] world //None of the request handlers matched - = if (getStaticOption options) - (http_staticResponse request world) (http_notfoundResponse request world) -makeResponse options request [(pred,handler):rest] world - | (pred request.req_path) = handler request world //Apply virtual page function - = makeResponse options request rest world //Search the rest of the list getPortOption :: [HTTPServerOption] -> Int diff --git a/Http/HttpUtil.dcl b/Http/HttpUtil.dcl index c30da05ed9c0406e13781ee1cfb19c0d0d8d4fd3..17f2d44a5a24b022d10e1f308c8e68d007f145be 100644 --- a/Http/HttpUtil.dcl +++ b/Http/HttpUtil.dcl @@ -19,6 +19,7 @@ http_parseUrlEncodedArguments :: !String -> [HTTPArgument] http_parseMultiPartPostArguments :: !HTTPRequest -> ([HTTPArgument],[HTTPUpload]) //Construction of HTTP Response messages +http_makeResponse :: !HTTPRequest [((String -> Bool),(HTTPRequest *World -> (HTTPResponse, *World)))] !Bool !*World -> (!HTTPResponse,!*World) http_encodeResponse :: !HTTPResponse !Bool !*World -> (!String,!*World) //Error responses diff --git a/Http/HttpUtil.icl b/Http/HttpUtil.icl index d8c92b7cd0d05a350bdbed4539a439436731417b..7d7d404bde74b96873c8ed142e5c47a890348d63 100644 --- a/Http/HttpUtil.icl +++ b/Http/HttpUtil.icl @@ -148,6 +148,16 @@ where = s % (start, end) //Construction of HTTP Response messages +http_makeResponse :: !HTTPRequest [((String -> Bool),(HTTPRequest *World -> (HTTPResponse, *World)))] !Bool !*World -> (!HTTPResponse,!*World) +http_makeResponse request [] fallback world //None of the request handlers matched + = if fallback + (http_staticResponse request world) //Use the static response handler + (http_notfoundResponse request world) //Raise an error +http_makeResponse request [(pred,handler):rest] fallback world + | (pred request.req_path) = handler request world //Apply handler function + = http_makeResponse request rest fallback world //Search the rest of the list + + http_encodeResponse :: !HTTPResponse !Bool !*World -> (!String, !*World) http_encodeResponse {rsp_headers = headers, rsp_data = data} withreply world //When used directly the 'Status' header should be converted to # (date,world) = getCurrentDate world diff --git a/Http/SubServer/Clean System Files/CFUNCLIB.OBJ b/Http/SubServer/Clean System Files/CFUNCLIB.OBJ new file mode 100644 index 0000000000000000000000000000000000000000..914c54526344d84c7275a7f43b9e84731eaa658b Binary files /dev/null and b/Http/SubServer/Clean System Files/CFUNCLIB.OBJ differ diff --git a/Http/SubServer/Clean System Files/KERNEL32.TXT b/Http/SubServer/Clean System Files/KERNEL32.TXT new file mode 100644 index 0000000000000000000000000000000000000000..a1acf74354c78dfdfebcc94f3a57a92f6149de60 --- /dev/null +++ b/Http/SubServer/Clean System Files/KERNEL32.TXT @@ -0,0 +1,6 @@ +KERNEL32.DLL +OpenFileMappingA@12 +GetCurrentProcessId@0 +RtlMoveMemory@12 +CreateSemaphoreA@16 +ReleaseSemaphore@12 \ No newline at end of file diff --git a/Http/SubServer/Clean System Files/REGERROR.OBJ b/Http/SubServer/Clean System Files/REGERROR.OBJ new file mode 100644 index 0000000000000000000000000000000000000000..33e205b197ed9d1645d369295ddb9f5a7f4f7cca Binary files /dev/null and b/Http/SubServer/Clean System Files/REGERROR.OBJ differ diff --git a/Http/SubServer/Clean System Files/REGEXP.OBJ b/Http/SubServer/Clean System Files/REGEXP.OBJ new file mode 100644 index 0000000000000000000000000000000000000000..08e5f23adc496130595197078bce3f037bc8a621 Binary files /dev/null and b/Http/SubServer/Clean System Files/REGEXP.OBJ differ diff --git a/Http/SubServer/Clean System Files/REGSUB.OBJ b/Http/SubServer/Clean System Files/REGSUB.OBJ new file mode 100644 index 0000000000000000000000000000000000000000..b7c3bd278cb0ffb88962e81d789a18fb8445a1bd Binary files /dev/null and b/Http/SubServer/Clean System Files/REGSUB.OBJ differ diff --git a/Http/SubServer/Clean System Files/SUBSERVER.OBJ b/Http/SubServer/Clean System Files/SUBSERVER.OBJ new file mode 100644 index 0000000000000000000000000000000000000000..565c8abf890bdd124830832634a2cd2456090fe2 Binary files /dev/null and b/Http/SubServer/Clean System Files/SUBSERVER.OBJ differ diff --git a/Http/SubServer/Clean System Files/USER32.TXT b/Http/SubServer/Clean System Files/USER32.TXT new file mode 100644 index 0000000000000000000000000000000000000000..323c8d70d3a59a9898e30f0d2c7f4ec1e84fb609 --- /dev/null +++ b/Http/SubServer/Clean System Files/USER32.TXT @@ -0,0 +1,2 @@ +USER32.DLL +FindWindowA@8 \ No newline at end of file diff --git a/Http/SubServer/Clean System Files/WSOCK32.TXT b/Http/SubServer/Clean System Files/WSOCK32.TXT new file mode 100644 index 0000000000000000000000000000000000000000..7cd1915bd6356e31fc0f868f0debc7b551509337 --- /dev/null +++ b/Http/SubServer/Clean System Files/WSOCK32.TXT @@ -0,0 +1,8 @@ +WSOCK32.DLL +WSACleanup@0 +WSAStartup@8 +send@16 +recv@16 +closesocket@4 +select@20 +shutdown@8 \ No newline at end of file diff --git a/Http/SubServer/HttpSubServer.dcl b/Http/SubServer/HttpSubServer.dcl new file mode 100644 index 0000000000000000000000000000000000000000..29e9afb3d06812d1150a39258aa1d7f7d5646f8b --- /dev/null +++ b/Http/SubServer/HttpSubServer.dcl @@ -0,0 +1,45 @@ +definition module HttpSubServer + +import Http, SubServerUtil + +// (c) 2006 Erwin Lips and Jacco van Drunen +// HIO - Breda +// Radboud University Nijmegen + +// This is an Http 1.1 SubServer written in Clean +// The SubServer can be linked with a Clean function generating Html code +// It creates a subserver application which can be attached to a Http 1.1 compliant main server. +// This can e.g. be an Apache server, a Microsoft IIS server, or the Clean Http 1.1 server. +// Several SubServers can be attached, and Strings and Files can be communicated + + +:: HTTPSubServerOption = HTTPSubServerOptPort Int // The port on which the server listens (default is 80) + | HTTPSubServerOptStaticFallback Bool // If all request handlers fail, should the static file handler be tried (default False) + | HTTPSubServerOptParseArguments Bool // Should the query and body of the request be parsed (default True) + | HTTPSubServerOptMaxServers Int // The maximum number of subserver processes to be started (default is 100) + + +//Wrapper function similar to http_startServer and http_startCGI +http_startSubServer :: [HTTPSubServerOption] [((String -> Bool),(HTTPRequest *World-> (HTTPResponse,*World)))] *World -> *World + +//The following types and functions can be used to implement a more advanced streaming subserver. +//For simple applications, it is advisable to just use the http_startSubServer wrapper + +:: Socket :== Int; + +//required functions +RegisterSubProcToServer :: !Int !Int !Int !String !String -> Int // priority minimum maximum number of subservers +WaitForMessageLoop :: ([String] Int Socket *World -> (Socket,*World)) Socket !*World -> *World + +//helper-functions for sending (suggested to use one of these) +SendString :: !String !String ![String] !Socket !*World -> (Socket,*World) +SendFile :: String ![String] !Socket !*World -> (Socket,*World) + +//helper-functions for receiving (optional to use one of these) +ReceiveString :: !Int !Int !Socket !*World -> (Int,String,Socket,*World) +ReceiveFile :: !Int !Socket !*File !*World -> (Bool,*File,*World) + +//extra functions (do not use these unless you know what you are doing, read the RFC first) +SendDataToClient :: !Socket !{#Char} !*env -> (!Socket,*env); +HTTPdisconnectGracefulC :: !Socket !*env -> *env; +DetectHttpVersionAndClose :: !String !String !Socket !*World -> (Socket,*World) \ No newline at end of file diff --git a/Http/SubServer/HttpSubServer.icl b/Http/SubServer/HttpSubServer.icl new file mode 100644 index 0000000000000000000000000000000000000000..b38d8fab56634ee2e6348d2d474c05530a09de44 --- /dev/null +++ b/Http/SubServer/HttpSubServer.icl @@ -0,0 +1,364 @@ +implementation module HttpSubServer + +import StdEnv, Directory +import Http, HttpUtil, SubServerUtil, Semaphore +import code from "REGEXP.OBJ" +import code from "REGSUB.OBJ" +import code from "REGERROR.OBJ" +import code from "CFUNCLIB.OBJ" +import code from "SUBSERVER.OBJ", library "KERNEL32.TXT", library "USER32.TXT", library "WSOCK32.TXT" + +// Create subserver talking to an http 1.1 server. +// One needs to create several copies of the same subserver to handle parallel request issues by an http 1.1 server. +// To prevent race conditions, calls to such a subserver copy is serialized using a semaphore. + +// This wrapper function works like the http_startServer and http_startCGI functions +http_startSubServer :: [HTTPSubServerOption] [((String -> Bool),(HTTPRequest *World-> (HTTPResponse,*World)))] *World -> *World +http_startSubServer options handlers world + # result = RegisterSubProcToServer 1 0 (getMaxServersOption options) ".*" ".*" //Handle all requests + | result == 1 + # (console,world) = stdio world + # (_,world) = fclose (fwrites ("Error: SubServer could *NOT* be registered to an HTTP 1.1 main server\n") console) world + = world + | result == 2 + # (console,world) = stdio world + # (_,world) = fclose (fwrites ("SubServer successfully registered to an HTTP 1.1 main server\n") console) world + = world + # (semaphore,world) = CreateSemaphore 0 1 1 "HttpSubServer" world + | semaphore == 0 = abort "CreateSemaphore failed" + # world = WaitForMessageLoop (callback semaphore handlers) (getPortOption options) world + # (ok,world) = CloseHandle semaphore world + | ok==0 = abort "CloseHandle failed" + = world +where + callback :: !Int [((String -> Bool),(HTTPRequest *World-> (HTTPResponse,*World)))] [String] Int Socket *World -> (Socket, *World) + callback semaphore handlers header contentlength socket world + # (alldatareceived,datafromclient,socket,world) = ReceiveString 0 contentlength socket world + # (method,path,query,version, ok) = http_parseRequestLine (hd header) + # headers = [hdr \\ (hdr, error) <- map http_parseHeader (tl header) | not error] + # request = {http_emptyRequest & req_method = method + , req_path = path + , req_query = query + , req_version = version + , req_headers = headers + , req_data = datafromclient + } + # request = if (getParseOption options) (http_parseArguments request) request + | socket==0 = (0,world) //socket closed or timed out + | alldatareceived == -1 + # (response,world) = indivisable options request handlers world + # (response,world) = http_encodeResponse response True world + = SendDataToClient socket response world + | alldatareceived <> 0 + = SendString "Unexpected request" "text/plain" header socket world + # (response,world) = indivisable options request handlers world + # (response,world) = http_encodeResponse response True world + = SendDataToClient socket response world + where + indivisable options request handlers world + # (_,world) = WaitForSingleObject semaphore -1 world + # (response,world) = http_makeResponse request handlers (getStaticOption options) world + # (_,world) = ReleaseSemaphore semaphore 1 0 world + = (response,world) + +getPortOption :: [HTTPSubServerOption] -> Int +getPortOption [] = 80 +getPortOption [x:xs] = case x of (HTTPSubServerOptPort port) = port + _ = getPortOption xs + +getStaticOption :: [HTTPSubServerOption] -> Bool +getStaticOption [] = False +getStaticOption [x:xs] = case x of (HTTPSubServerOptStaticFallback b) = b + _ = getStaticOption xs + +getParseOption :: [HTTPSubServerOption] -> Bool +getParseOption [] = True +getParseOption [x:xs] = case x of (HTTPSubServerOptParseArguments b) = b + _ = getParseOption xs + +getMaxServersOption :: [HTTPSubServerOption] -> Int +getMaxServersOption [] = 100 +getMaxServersOption [x:xs] = case x of (HTTPSubServerOptMaxServers num) = num + _ = getMaxServersOption xs + + +RegisterSubProcToServer :: !Int !Int !Int !String !String -> Int; +RegisterSubProcToServer _ _ _ _ _ = code{ + ccall RegisterSubProcToServer "IIISS:I" +} + +WaitForMessage :: (!Bool,!Socket,!String); +WaitForMessage = code{ + ccall WaitForMessage ":VIIS" +} + +RecvContent :: !Socket !String -> Bool; +RecvContent _ _ = code{ + ccall RecvContent "IS:I" +} + +HTTPrecvC :: !Socket !String -> Int; +HTTPrecvC _ _ = code{ + ccall HTTPrecvC "IS:I" +} + +MatchRegExpr :: !String -> Bool; +MatchRegExpr _ = code{ + ccall MatchRegExpr "S:I" +} + +FreeSharedMem :: !Int !*env -> *env; +FreeSharedMem _ _ = code{ + ccall FreeSharedMem "I:V:A" +} + +SetContentLength :: !Int !*env -> *env; +SetContentLength _ _ = code{ + ccall SetContentLength "I:V:A" +} + +SendDataToClient :: !Socket !{#Char} !*env -> (!Socket,*env); +SendDataToClient 0 _ world = (0,world) +SendDataToClient socket data world + # (_,world) = sendAPI socket data (size data) 0 world + = (socket,world) +where + sendAPI :: !Socket !{#Char} !Int !Int !*env -> (!Int,*env); + sendAPI _ _ _ _ _ = code{ + ccall send@16 "PIsII:I:A" + } + +HTTPdisconnectGracefulC :: !Socket !*env -> *env; +HTTPdisconnectGracefulC _ _ = code{ + ccall HTTPdisconnectGracefulC "I:V:A" +} + +makeNewString :: !Int -> {#.Char}//function to allocate memory for a new string +makeNewString _ = code inline{ + create_array_ CHAR 0 1 +} + +ReadTotalHeaderFromSocket :: Int [String] Socket !*World -> ([String],Socket,*World) +ReadTotalHeaderFromSocket 0 header socket world//first line (example: GET / HTTP/1.0) + # (newheaderline,socket,world) = ReadHeaderFromSocket socket world + | socket==0 = ([],0,world) + # (newheaderline,socket,world) = case newheaderline of//empty line is allowed at the beginning of a request -> RFC2616 section 4.1 + "\r\n" -> ReadHeaderFromSocket socket world + _ -> (newheaderline,socket,world) + | socket==0 = ([],0,world) + # newheaderline = newheaderline % (0,size newheaderline - 3)//remove '\r\n' at the end of the line + # (method,location,getDataArray,version) = GetFirstLine newheaderline + | method=="" || location=="" || version=="" || version % (0,4)<>"HTTP/"//check correctness of the first line + # (socket,world) = SendDataToClient socket "HTTP/1.1 400 Bad Request\r\nConnection: close\r\n\r\n" world + # world = HTTPdisconnectGracefulC socket world + = ([],0,world) + | MatchRegExpr location//match the new location against the regular expression, no match means sending back to mainserver + # (headerlist,socket,world) = ReadTotalHeaderFromSocket 1 (header++[newheaderline]) socket world + | socket==0 = ([],0,world) + # hostname = (GetHeaderData headerlist "HOST:") + | hostname=="" + # (socket,world) = SendDataToClient socket "HTTP/1.1 400 Bad Request\r\nConnection: close\r\n\r\n" world + # world = HTTPdisconnectGracefulC socket world + = ([],0,world) + # (socket,world) = SendDataToClient socket "HTTP/1.1 302 Found\r\nConnection: close\r\nLocation: http://" world + # (socket,world) = SendDataToClient socket hostname world + # (socket,world) = SendDataToClient socket location world + # (socket,world) = SendDataToClient socket "\r\nContent-Type: text/plain\r\nContent-Length: 18\r\n\r\nSubserver Redirect" world//a little text is required when using a redirect -> RFC2616 section 10.3.2 + # world = HTTPdisconnectGracefulC socket world + = ([],0,world) + = ReadTotalHeaderFromSocket 1 (header++[newheaderline]) socket world +ReadTotalHeaderFromSocket 99 header socket world//reached maximum lines, must be an evil request + = ([],0,HTTPdisconnectGracefulC socket world) +ReadTotalHeaderFromSocket linenumber header socket world + # (newheaderline,socket,world) = ReadHeaderFromSocket socket world + | newheaderline=="\r\n" || socket==0 = (header,socket,world)//stop reading header + # newheaderline = newheaderline % (0,size newheaderline - 3)//remove '\r\n' at the end of the line + = ReadTotalHeaderFromSocket (linenumber+1) (header++[newheaderline]) socket world + +ReadHeaderFromSocket :: Socket !*World -> (String,Socket,*World) +ReadHeaderFromSocket socket world + # (success,world) = ReadHeaderFromSocket` world + | success = (data,socket,world)//reading header succeeded + | otherwise = ("",0,HTTPdisconnectGracefulC socket world)//reading header failed +where + data = makeNewString 4092//4092 = sizeof(a page in Windows) - sizeof(int), hope to increase some allocation speed this way + ReadHeaderFromSocket` :: !*World -> (Bool,*World) + ReadHeaderFromSocket` world + # eorl = HTTPrecvC socket data//eorl = short for End Of Read Line + | eorl==2 = (False,world)//line too long, or timeout + | eorl==1 = (True,world)//reached the '\n' + = ReadHeaderFromSocket` world//eorl=0, keep reading the line + +WaitForMessageLoop :: ([String] Int Socket *World -> (Socket,*World)) Socket !*World -> *World +WaitForMessageLoop handlefunction 0 world + #! (success,socket,header) = WaitForMessage + | success + #! headerlist = SplitToStringArray header "\r\n" + #! world = FreeSharedMem 0 world//from this point, the same code as below, TODO: replace same code + #! cl = toInt(GetHeaderData headerlist "CONTENT-LENGTH:") + #! encoding = GetHeaderData headerlist "TRANSFER-ENCODING:" + | cl==0 && encoding <> "" && encoding <> "chunked"//only chunked is required, otherwise send 501 Unimplemented -> RFC2616 section 3.6 + #! (socket,world) = SendDataToClient socket "HTTP/1.1 501 Unimplemented\r\nConnection: close\r\nContent-Type: text/plain\r\nContent-Length: 27\r\n\r\nOnly Chunked Is Implemented" world//a little text is required when using a 5xx error -> RFC2616 section 10.5 + = WaitForMessageLoop handlefunction 0 (HTTPdisconnectGracefulC socket world) + #! cl = case encoding of + "chunked" = -1//-1 represents the chunked mode in both the ReceiveString and the functions in C + _ = cl + #! world = SetContentLength cl world//remember the contentlength in C, so later we check on it to know if there is data on the socket + #! (socket,world) = case (GetHeaderData headerlist "EXPECT:") of + "100-continue" -> SendDataToClient socket "HTTP/1.1 100 Continue\r\n\r\n" world//a client could expect a 100 reply before sending the data -> RFC2616 section 8.2.3 + _ -> (socket,world) + #! (socket,world) = handlefunction headerlist cl socket world + = WaitForMessageLoop handlefunction socket world + = world +WaitForMessageLoop handlefunction socket world + #! (headerlist,socket,world) = ReadTotalHeaderFromSocket 0 [] socket world + | socket==0 = WaitForMessageLoop handlefunction 0 world + #! cl = toInt(GetHeaderData headerlist "CONTENT-LENGTH:") + #! encoding = GetHeaderData headerlist "TRANSFER-ENCODING:" + | cl==0 && encoding <> "" && encoding <> "chunked"//only chunked is required, otherwise send 501 Unimplemented -> RFC2616 section 3.6 + #! (socket,world) = SendDataToClient socket "HTTP/1.1 501 Unimplemented\r\nConnection: close\r\nContent-Type: text/plain\r\nContent-Length: 27\r\n\r\nOnly Chunked Is Implemented" world//a little text is required when using a 5xx error -> RFC2616 section 10.5 + = WaitForMessageLoop handlefunction 0 (HTTPdisconnectGracefulC socket world) + #! cl = case encoding of + "chunked" = -1 + _ = cl + #! world = SetContentLength cl world//remember the contentlength in C, so later we check on it to know if there is data on the socket + #! (socket,world) = case (GetHeaderData headerlist "EXPECT:") of + "100-continue" -> SendDataToClient socket "HTTP/1.1 100 Continue\r\n\r\n" world//a client could expect a 100 reply before sending the data -> RFC2616 section 8.2.3 + _ -> (socket,world) + #! (socket,world) = handlefunction headerlist cl socket world + = WaitForMessageLoop handlefunction socket world + +//gebruikers afhandelfunctie voor het verzenden van een bestand +SendFile :: String ![String] !Socket !*World -> (Socket,*World) +SendFile directory header sock world + # (method,location,getDataArray,version) = GetFirstLine (hd header) + # location = directory +++ CheckLocation location + | location=="" + # (sock,world) = SendDataToClient sock (version +++" 404 Not Found\r\nContent-Length: 0\r\n\r\n") world + = DetectHttpVersionAndClose version (GetHeaderData header "Connection:") sock world + # (ok,file,world) = fopen location FReadData world//probeer bestand te openen + | not ok + # (sock,world) = SendDataToClient sock (version +++" 404 Not Found\r\nContent-Length: 0\r\n\r\n") world + = DetectHttpVersionAndClose version (GetHeaderData header "Connection:") sock world + # ((_,path),world)= pd_StringToPath location world + # ((error,info),world)= getFileInfo path world + # {pi_fileInfo=piinfo}=info + # {fileSize=sizeFile}=piinfo + # string = GetHeaderData header "Content-Range:" + | string<>"" + # first = FindIndexInString string "-" 0 + # firstPoint = toInt(string % (6,first-1)) + # tmp = string % (first+1,size string) + # second = FindIndexInString tmp "/" 0 + # secondPoint = toInt(tmp % (0,second-1)) + # thirdPoint = toInt(tmp % (second+1,size tmp)) + | first==(-1) || second ==(-1) || firstPoint >= secondPoint || secondPoint > thirdPoint || secondPoint > (fst sizeFile) + # (sock,world) = SendDataToClient sock "HTTP/1.0 400 Bad Request\r\nContent-Length: 0\r\n\r\n" world + = DetectHttpVersionAndClose version (GetHeaderData header "Connection:") sock world + # (ok,file) = fseek file firstPoint FSeekSet + | not ok + # (sock,world) = SendDataToClient sock (version+++" 501 Internal Server Error\r\nContent-Length: 0\r\n\r\n") world + # (_,world) = fclose file world + = DetectHttpVersionAndClose version (GetHeaderData header "Connection:") sock world + # (sock,world) = SendDataToClient sock (version+++" 206 Partial content\r\n") world + # (sock,world) = SendDataToClient sock ("Content-Range: "+++string+++"\r\n") world + # contentType= getContentTypeGF (location % ((FindIndexInString location "." 0),size location)) + # (sock,world) = SendDataToClient sock ("Content-Length: "+++toString(secondPoint-firstPoint)) world + # (sock,world) = SendDataToClient sock ("\r\nAccept-Ranges: bytes\r\n\r\n") world + | method<>"HEAD" + # (sock,file,world) = SendFile` (secondPoint-firstPoint) sock file world + # (_,world) = fclose file world + = DetectHttpVersionAndClose version (GetHeaderData header "Connection:") sock world + # (_,world) = fclose file world + = DetectHttpVersionAndClose version (GetHeaderData header "Connection:") sock world + # contentType= getContentTypeGF (location % ((FindIndexInString location "." 0),size location)) + # (sock,world) = SendDataToClient sock (version+++" 200 OK\r\n") world + # (sock,world) = SendDataToClient sock ("Content-Type: "+++contentType+++"\r\n") world + # (sock,world) = SendDataToClient sock ("Content-Length: "+++(toString (fst sizeFile))+++"\r\n\r\n") world + | method<>"HEAD" + # (sock,file,world) = SendFile` (fst sizeFile) sock file world + # (_,world) = fclose file world + = DetectHttpVersionAndClose version (GetHeaderData header "Connection:") sock world + # (_,world) = fclose file world + = DetectHttpVersionAndClose version (GetHeaderData header "Connection:") sock world + +SendFile` :: !Int !Socket !*File !*World-> (Socket,*File,*World)//functie die alle gegevens uit een bestand leest +SendFile` bytes sock file world + # read = case (bytes>4096) of + True = 4096 + _ = bytes + # (data,file) = freads file read + # (sock,world)= SendDataToClient sock data world + | (bytes-read)==0 = (sock,file,world) + = SendFile` (bytes-read) sock file world + +DetectHttpVersionAndClose :: !String !String !Socket !*World -> (Socket,*World) +DetectHttpVersionAndClose version connection sock world + | version=="HTTP/1.0" = (0,HTTPdisconnectGracefulC sock world) + | connection == "close" = (0,HTTPdisconnectGracefulC sock world) + = (sock,world) + +SendString :: !String !String ![String] !Socket !*World -> (Socket,*World) +SendString _ _ _ 0 world = (0,world)//called function with a closed socket +SendString str contenttype requestheader sock world + # (method,location,getDataArray,version) = GetFirstLine (hd requestheader) + # (sock,world) = case version of//does not exist in the other SendString function + "HTTP/1.0" -> SendDataToClient sock "HTTP/1.0" world//does not exist in the other SendString function + _ -> SendDataToClient sock "HTTP/1.1" world//does not exist in the other SendString function + | method<>"GET" && method<>"HEAD" && method<>"POST" + # (sock,world) = SendDataToClient sock " 405 Method Not Allowed\r\nAllow: GET, HEAD, POST\r\nConnection: close\r\n\r\n" world//an Allow-field must be present with a 405 error -> RFC2616 section 14.7 + = (0,HTTPdisconnectGracefulC sock world)//does not exist in the other SendString function + # (sock,world) = SendDataToClient sock " 200 OK\r\nContent-Type: " world + # (sock,world) = SendDataToClient sock contenttype world + # (sock,world) = SendDataToClient sock "\r\nContent-Length: " world + # strsize = (toString (size str)) + # (sock,world) = SendDataToClient sock strsize world + # (sock,world) = SendDataToClient sock "\r\n\r\n" world + # (sock,world) = case method of + "HEAD" -> (sock,world) + _ -> SendDataToClient sock str world + = DetectHttpVersionAndClose version (GetHeaderData requestheader "CONNECTION:") sock world + +ReadChunkSize :: !Socket !*World -> (Int,Socket,*World) +ReadChunkSize sock world + # (data,sock,world) = ReadHeaderFromSocket sock world + = (HexLineToInt (fromString (data % (0,size data - 3))),sock,world) + +ReadChunkData :: !Int !Socket !*World -> (String,Socket,*World) +ReadChunkData 0 sock world = ("",sock,world)//reached the end of the chunked data +ReadChunkData _ 0 world = ("",0,world)//function called with a closed socket +ReadChunkData chunksize sock world + # world = SetContentLength chunksize world//set to the actuall size, so RecvContent (in C) won't get stuck on it + # (_,chunkdata,sock,world) = ReceiveString chunksize 1 sock world + # world = SetContentLength 0 world//set to 0, so ReadHeaderFromSocket won't get stuck on it + # (_,sock,world) = ReadHeaderFromSocket sock world//read an empty line + # (chunksize,sock,world) = ReadChunkSize sock world + # (newchunkdata,sock,world) = ReadChunkData chunksize sock world + = (chunkdata+++newchunkdata,sock,world)//WARNING: possibly creating giga-strings here + +ReceiveString :: !Int !Int !Socket !*World -> (Int,String,Socket,*World) +ReceiveString _ _ 0 world = (-1,"",0,world)//function called with a closed socket +ReceiveString _ 0 sock world = (-1,"",sock,world)//contentlength was zero no data downloaded +ReceiveString _ -1 sock world//-1 means that 'Transfer-Encoding: chunked' is used, chunked is required for all 1.1 apps -> RFC2616 section 3.6.1 + # world = SetContentLength 0 world//set to 0, so ReceiveString won't get stuck on it + # (chunksize,sock,world) = ReadChunkSize sock world + # (allchunkdata,sock,world) = ReadChunkData chunksize sock world + | sock==0 = (0,"",0,HTTPdisconnectGracefulC sock world)//stop reading content + # world = SetContentLength -1 world//the ReceiveString messes up the contentlength in C, so set it back + = (0,allchunkdata,sock,world) +ReceiveString expectedlength contentlength sock world + # expectedlength = case expectedlength of + 0 -> contentlength//autodetect expected length + _ -> expectedlength + # data = makeNewString expectedlength + | RecvContent sock data = (0,"",0,world)//timed-out or disconnected, close was already done in the RecvContent-function + | expectedlength < contentlength = (contentlength-expectedlength,data,sock,world) + = (0,data,sock,world) + +ReceiveFile :: !Int !Socket !*File !*World -> (Bool,*File,*World) +ReceiveFile _ 0 file world = (False,file,world)//called with closed socket +ReceiveFile 0 _ file world = (True,file,world)//called with a contentlength of zero or reached the end of the data +ReceiveFile contentlength socket file world + # (alldatareceived,data,socket,world) = ReceiveString 4096 contentlength socket world + # file = fwrites data file + = ReceiveFile alldatareceived socket file world \ No newline at end of file diff --git a/Http/SubServer/Semaphore.dcl b/Http/SubServer/Semaphore.dcl new file mode 100644 index 0000000000000000000000000000000000000000..c3da7d8a79ab0d83ebf74c5443a7950f780a9b21 --- /dev/null +++ b/Http/SubServer/Semaphore.dcl @@ -0,0 +1,6 @@ +definition module Semaphore + +CreateSemaphore :: !Int !Int !Int !{#Char} !*World -> (!Int,!*World); +WaitForSingleObject :: !Int !Int !*World -> (!Int,!*World); +ReleaseSemaphore :: !Int !Int !Int !*World -> (!Int,!*World); +CloseHandle :: !Int !*World -> (!Int,!*World); diff --git a/Http/SubServer/Semaphore.icl b/Http/SubServer/Semaphore.icl new file mode 100644 index 0000000000000000000000000000000000000000..b41955b61eebae2d05a1d8927378367f1d31a36a --- /dev/null +++ b/Http/SubServer/Semaphore.icl @@ -0,0 +1,46 @@ +implementation module Semaphore; + +import StdEnv; + +INFINITE :== -1; + +// add CreateSemaphoreA@16 and ReleaseSemaphore@12 to kernel_library for Clean 2.2 and older + +CreateSemaphore :: !Int !Int !Int !{#Char} !*World -> (!Int,!*World); +CreateSemaphore semaphoreAttributes initialCount maximumCount name world = code { + ccall CreateSemaphoreA@16 "PIIIs:I:A" +} + +WaitForSingleObject :: !Int !Int !*World -> (!Int,!*World); +WaitForSingleObject handle milliseconds world = code { + ccall WaitForSingleObject@8 "PII:I:A" +} + +ReleaseSemaphore :: !Int !Int !Int !*World -> (!Int,!*World); +ReleaseSemaphore semaphore releaseCount previousCount_p world = code { + ccall ReleaseSemaphore@12 "PIII:I:A" +} + +CloseHandle :: !Int !*World -> (!Int,!*World); +CloseHandle handle world = code { + ccall CloseHandle@4 "PI:I:A" +} + +Start w + # semaphore_name = "MySemaphoreName"; + + # (semaphore,world) = CreateSemaphore 0 1 1 semaphore_name w; + | semaphore==0 + = abort "CreateSemaphore failed"; + + # (r,world) = WaitForSingleObject semaphore INFINITE world; + + # (stdout,world) = stdio world; + # (ok,c,stdout) = freadc stdout; + # (ok,world) = fclose stdout world; + + # (ok,world) = ReleaseSemaphore semaphore 1 0 world; + + # (ok,world) = CloseHandle semaphore world; + | ok==0 + = abort "CloseHandle failed"; diff --git a/Http/SubServer/SubServerUtil.dcl b/Http/SubServer/SubServerUtil.dcl new file mode 100644 index 0000000000000000000000000000000000000000..3d020377f507cae4168a52f119e554c12122e2ac --- /dev/null +++ b/Http/SubServer/SubServerUtil.dcl @@ -0,0 +1,130 @@ +definition module SubServerUtil + +// (c) 2005 Paul de Mast +// (c) 2006 Erwin Lips and Jacco van Drunen +// HIO - Breda +// Radboud University Nijmegen + +// a collection of utility functions used by the http server / http subserver + +import StdEnv, StdMaybe, StdLibMisc + +/**************************************************************************** + Set of handy http related functions for the end user +****************************************************************************/ + +GetHeaderData :: [String] *String -> String // Returns method, location, GET data, http version*/ +GetFirstLine :: String -> (String,String,[String],String) +HexLineToInt :: [Char] -> Int +URLDecode :: [Char] -> String +CheckLocation :: String -> String +getContentTypeGF :: String -> String + +/**************************************************************************** + String handling utility functions +****************************************************************************/ + +CountStringInString :: String String -> Int + +StringToUppercase :: Int *String ->*String // Converting a string to a uppercase string, int for begin place in string +TrimString :: String -> String // Removes spaces at beginning and end of a string +FindIndexInString :: String String Int -> Int // Find the index place in the string, based on the second string, int for begin place in first string +ToUniqueString :: String -> *String // Convert a string to a unique string +SplitToStringArray :: String String -> [String] // Split a string in a list of stringd, using on the second string as delimiter + // Example: SplitToStringArray "This:is:a:string" ":" = ["This","is","a","string"] +StringArrayToTupple :: [String] String -> [(String,String)] // Example: StringArrayToTupple ["Name:data","Name1: data1"] ":" = [("Name","data"),("Name1","data1")] +StringArrayCount :: [String] -> Int +CountStringInArray :: [String] String Int -> Int +StringArrayToString :: [String] String -> String + +/**************************************************************************** + as -- bs removes all elements in bs from as +****************************************************************************/ +(--) infixl 5 :: [a] [a] -> [a] | Eq a + +/********************************************************************** + General sorting and ordening of a list of elements +***********************************************************************/ +sortOn :: [(t t -> Bool)] [t] -> [t] +groupOn :: [t -> a] [t] -> [[t]] | ==, < a +splitWith :: (a -> Bool) [a] -> ([a], [a]) + +/********************************************************************** + Some String utilities: +***********************************************************************/ +/* words string = list of words in the string */ +words :: !a -> [String] | toString a + +wordsWith :: !.Char !String -> [String] + +/* a String is split in a part until the seperator and the rest */ +splitAfter :: !.Char !String -> (!String,!String) +cSplit :: !.Char !String -> (!String,!String) +sSplit :: !String !String -> (!String,!String) + +/* flatWith listOfStrings seperator stringlist = concatenates strings with seperator */ +flatWith :: !a ![b] -> String | toString a & toString b + +/* endWith listOfStrings suffix stringlist = concatenates strings with suffix after each string*/ +endWith :: !a ![b] -> String | toString a & toString b + +/* unwords = flatWith ' ' */ +unwords :: ![a] -> String | toString a + +/* unlines = flatWith '\n' */ +unlines :: ![a] -> String | toString a + +trim :: String -> String // remove whitespace at start and end of a String +trimQuotes :: String -> String // ""text"" -> "text" + +substring :: String String -> Bool +match :: String String -> Bool + +stringToUpper :: String -> String +stringToLower :: String -> String + +/********************************************************************** + Instances on Maybe: +***********************************************************************/ + +instance < (Maybe a) | < a +instance toString (Maybe a) | toString a + +/********************************************************************** + To read all the characters from one File in one readacces + returns: a String containing all characters in a file +***********************************************************************/ + +readFile :: *File -> (String, *File) + +/********************************************************************** + To read all the lines from one File + returns: a list of lines without the "\n" +***********************************************************************/ + +readStrings :: *File -> ([String], *File) + + +/********************************************************************** + To save a list of files: [(fileName,fileContents)] +***********************************************************************/ + +exportFiles :: [(String,String)] *Files -> ([String],*Files) + +/********************************************************************** + Some funtion from the Haskell prelude: +***********************************************************************/ +// from the Haskell prelude: + +(hseq) infixr 0 :: !.a .b -> .b + +($) infixr 0 +($) f x :== f x + +instance == (Either a b) | == a & == b + +lookup :: a [(a,.b)] -> Maybe .b | == a; +foldr1 :: (.a -> .(.a -> .a)) ![.a] -> .a; +concatMap :: (.a -> [w:b]) -> u:([.a] -> v:[w:b]), [u <= v, u <= w] +fromMaybe :: a (Maybe a) -> a + diff --git a/Http/SubServer/SubServerUtil.icl b/Http/SubServer/SubServerUtil.icl new file mode 100644 index 0000000000000000000000000000000000000000..153d3769935d48d42a7167844d663d4431c2f7f0 --- /dev/null +++ b/Http/SubServer/SubServerUtil.icl @@ -0,0 +1,475 @@ +implementation module SubServerUtil +import StdEnv, StdLib, StdMaybe + +/**************************************************************************** + Set of handy http related functions for the end user +****************************************************************************/ + +/*1e method, 2e location, 3e get data, 4e http version*/ +GetFirstLine :: String -> (String,String,[String],String) +GetFirstLine firstLine +| length data <>3 = ("","",[],"") +| otherwise + # location=data!!1 + # location = case location % (0,6) == "http://" of + True=location % ((FindIndexInString (location % (7,size location)) "/" 0)+7,size location) + _=location + # location = case location == "" of + True="/" + _=URLDecode (fromString location) + # nr = FindIndexInString location "?" 0 + | nr==(-1) = (data!!0,location,[],data!!2) + = (data!!0,location % (0,nr-1),(SplitToStringArray (location %(nr+1,size (location)))) "&",data!!2) +where + data = SplitToStringArray firstLine " " + +HexLineToInt :: [Char] -> Int +HexLineToInt [a] = toInt(hexToChar a) +HexLineToInt [a,b] = (16 * toInt(hexToChar a)) + HexLineToInt [b] +HexLineToInt [a,b,c] = (256 * toInt(hexToChar a)) + HexLineToInt [b,c] +HexLineToInt [a,b,c,d] = (4096 * toInt(hexToChar a)) + HexLineToInt [b,c,d] +HexLineToInt _ = 0 + +URLDecode :: [Char] -> String//URLDecode-functie (zet %?? om naar juiste characters, %20 naar spatie bijv.) +URLDecode [] = "" +URLDecode ['%',a,b:tail] = toString ((toChar (16 * toInt (hexToChar a))) + hexToChar b)+++ URLDecode tail +URLDecode ['+':tail]= " "+++URLDecode tail +URLDecode [head:tail] = toString head +++URLDecode tail + +hexToChar :: Char -> Char//functie is onderdeel van removeEscapes +hexToChar a + | a >= '0' && a <= '9' = a - '0' + | a >= 'A' && a <= 'F' = a - 'A' + (toChar 10) + | a >= 'a' && a <= 'f' = a - 'a' + (toChar 10) + = toChar 0 + +GetHeaderData :: [String] *String -> String//ook een hulpfunctie, tevens interne functie +GetHeaderData [as:bs] header + #string1 = ToUniqueString(as % (0,(size header)-1)) + # string = StringToUppercase 0 string1 + # header = StringToUppercase 0 header + | string==header = TrimString (as % ((size header),size as)) + = GetHeaderData bs header +GetHeaderData _ _ = "" + +getContentTypeGF :: String -> String//functie die Content-Type genereert aan de hand van de extensie +getContentTypeGF ".jpg" = "image/jpeg" +getContentTypeGF ".gif" = "image/gif" +getContentTypeGF ".bmp" = "image/x-ms-bmp" +getContentTypeGF ".htm" = "text/html" +getContentTypeGF ".txt" = "text/plain" +getContentTypeGF "" = "application/octet-stream\r\nContent-Disposition: attachment;"//forceer download (bij video's bijv., zodat deze niet meteen worden afgespeeld) +getContentTypeGF str = getContentTypeGF (str % (1,size str)) + +CheckLocation ::String -> String +CheckLocation location +# array = SplitToStringArray (location % (1,size location)) "/" +| hd array ==".." = "" +# array = FlattenLocation array +| hd array ==".." = "" +| (hd array) % (0,0)=="%" = "" +# countBack = CountStringInArray array ".." 0 +# bool = StringArrayCount array - countBack > countBack +| not bool = "" += StringArrayToString array "\\" + +FlattenLocation :: [String] -> [String] +FlattenLocation array +# array1 = FlattenLocation1 array +| array == array1 = array1 += FlattenLocation array1 +where + FlattenLocation1 [as,bs:cs] + | as==".." && bs==".." && cs<>[]= [as]++ FlattenLocation1 ([bs]++cs) + | as==".." && bs<>".."&& cs<>[]= FlattenLocation1 cs + | bs==".." && cs<>[] = FlattenLocation1 cs + | cs<>[] = [as]++ FlattenLocation1 ([bs]++cs) + FlattenLocation1 [as,bs] = [as,bs] + FlattenLocation1 [as] = [as] + +/**************************************************************************** + String handling utility functions +****************************************************************************/ + +CountStringInString :: String String -> Int +CountStringInString string token +# index = FindIndexInString string token 0 +| index > -1 = 1 + CountStringInString (string % (index+size token,size string)) token += 0 + +StringToUppercase :: Int *String ->*String +StringToUppercase nr string +| nr < 0 = string +| size string > nr + #! char = CharToUppercase string.[nr] + # string = update string nr char + = StringToUppercase (nr+1) string +| otherwise = string + +CharToUppercase :: Char -> Char +CharToUppercase char +| int > 96 && int < 123 = toChar (int bitand (0xdf)) +| otherwise = char +where + int = toInt char + +TrimString::String -> String +TrimString string +| (FindIndexInString string "\t" 0)==0 = TrimString (string % (1,size string)) +| string %(size string-1,size string)=="\t"= TrimString (string % (0,size string-2)) +| (FindIndexInString string " " 0)==0 = TrimString (string % (1,size string)) +| string %(size string-1,size string)==" "= TrimString (string % (0,size string-2)) +| otherwise = string + +SplitToStringArray :: String String -> [String] +SplitToStringArray string token +| string==""=[] +| nr <> -1 = [string % (0,(nr-1))]++SplitToStringArray (string % ((nr+(size token)),size string)) token +| otherwise = [string] +where + nr = FindIndexInString string token 0 + +FindIndexInString ::String String Int -> Int +FindIndexInString string token nr +| nr>size string || token==""= -1 +| string %(nr,nr+(size token)-1)==token = nr +| ((size string) - 1)== nr = -1 +| otherwise = FindIndexInString string token (nr+1) + +StringArrayToTupple::[String] String -> [(String,String)] +StringArrayToTupple [as:bs] token +# index = FindIndexInString as token 0 +| index== -1 = StringArrayToTupple bs token +| otherwise = [(as % (0,(index-1)),as%((index+size token),size as))]++ StringArrayToTupple bs token +StringArrayToTupple _ _ = [] + +ToUniqueString :: String -> *String +ToUniqueString c = {c.[i] \\ i <- [0..(size c-1)]} + +CountStringInArray :: [String] String Int -> Int +CountStringInArray [as:bs] token nr +| as==token = CountStringInArray bs token nr+1 +| otherwise = CountStringInArray bs token nr +CountStringInArray _ _ nr = nr + +StringArrayCount :: [String] -> Int +StringArrayCount [as:bs] = 1 + StringArrayCount bs +StringArrayCount _ = 0 + +StringArrayToString :: [String] String-> String +StringArrayToString [as:bs] token= token+++as +++ StringArrayToString bs token +StringArrayToString _ _= "" + +/**************************************************************************** + as -- bs removes all elements in bs from as +****************************************************************************/ +(--) infixl 5 :: [a] [a] -> [a] | Eq a +(--) as bs = removeMembers as bs + +/********************************************************************** + General sorting and ordening of a list of elements +***********************************************************************/ +sortOn :: [(t t -> Bool)] [t] -> [t] +sortOn ps items += sortBy (combined ps) items +where + combined :: [ (t t -> Bool) ] t t -> Bool + combined [] x y = True + combined [p:ps] x y = (p x y == p y x && combined ps x y) || p x y + +groupOn :: [t -> a] [t] -> [[t]] | ==, < a +groupOn fs xs = (groupBy eqf o sortOn (map smf fs)) xs +where + eqf a b = [f a \\ f <- fs] == [f b \\ f <- fs] + smf f a b = f a < f b + +splitWith :: (a -> Bool) [a] -> ([a], [a]) +splitWith _ [] = ([],[]) +splitWith p [x:xs] + | p x = ([x:as],bs) + | otherwise = (as,[x:bs]) + where + (as,bs) = splitWith p xs + + + +/********************************************************************** + Some String utilities: +***********************************************************************/ +words :: !a -> [String] | toString a +words a + | size s == 0 = [] + | otherwise = [s%(b,e-1) \\ (b,e) <- bes2] +where + s = toString a + bes1 = [i \\ i <- [1..(size s - 1)] | (isSpace s.[i]) <> (isSpace s.[i-1])] + // alleen nog de vraag of je zo niet het laatste woord mist? + // zo ja moeten we nog (size s - 1) aan de staart van bes1 toevoegen... + // waarschijnlijk handigst in zip` met + // zip` [b] = [(b,size s - 1)] + bes2 + | isSpace s.[0] + = zip` bes1 + = zip` [0:bes1] + + zip` [b] = [(b,size s)] + zip` [b,e:r] = [(b,e):zip` r] + zip` _ = [] + +wordsWith :: !.Char !String -> [String] +wordsWith c s + | s=="" && r=="" = [] + | r=="" = [s] + | otherwise = [f : wordsWith c r] +where + (f,r) = cSplit c s + +splitAfter :: !.Char !String -> (!String,!String) +splitAfter c s = (s%(b1,e1),s%(b2,e2)) +where + sp = findPos c s 0 e2 + b1 = 0 + e1 = sp + b2 = sp + 1 + e2 = size s + + findPos :: Char String Int Int -> Int + findPos c s i end + | i >= end = end + | s.[i] == c = i + | otherwise = findPos c s (inc i) end + +cSplit :: !.Char !String -> (!String,!String) +cSplit c s = (s%(b1,e1),s%(b2,e2)) +where + sp = findPos c s 0 e2 + b1 = 0 + e1 = sp - 1 + b2 = sp + 1 + e2 = size s + + findPos :: Char String Int Int -> Int + findPos c s i end + | i >= end = end + | s.[i] == c = i + | otherwise = findPos c s (inc i) end + +sSplit :: !String !String -> (!String,!String) +sSplit sep s = (s%(b1,e1),s%(b2,e2)) +where + sp = findPos sep s 0 e2 + b1 = 0 + e1 = sp - 1 + b2 = sp + ic + 1 + e2 = size s + ic = size sep-1 + + findPos :: String String Int Int -> Int + findPos c s i end + | i >= end = end + | s%(i,i+ic) == c = i + | otherwise = findPos c s (inc i) end + +unwords :: ![a] -> String | toString a +unwords ss = flatWith " " ss + +unlines :: ![a] -> String | toString a +unlines ss = flatWith "\n" ss + +/*flatWith :: !a ![b] -> String | toString a & toString b +flatWith s [] = "" +flatWith s [h] = toString h +flatWith s [h:t] = toString h +++ toString s +++ flatWith s t +*/ + +flatWith :: !a ![b] -> String | toString a & toString b +flatWith sep items += copyLines (createArray (sum (map size lines) + nrOfSep * (size ssep)) ' ') 0 lines +where + nrOfSep + | isEmpty items = 0 + | otherwise = length items - 1 + + lines = map toString items + ssep = toString sep + + copyLines result n [] = result + copyLines result n [l] + # (_,result) = sup (size l) n 0 result l + = result + + copyLines result n [l:ls] + # (n,result) = sup (size l) n 0 result l + # (n,result) = sup (size ssep) n 0 result ssep + = copyLines result n ls + + +endWith :: !a ![b] -> String | toString a & toString b +endWith suffix items += copyLines (createArray (sum (map size lines) + nrOfSep * (size ssuffix)) ' ') 0 lines +where + nrOfSep = length items + + lines = map toString items + ssuffix = toString suffix + + copyLines result n [] = result + + copyLines result n [l:ls] + # (n,result) = sup (size l) n 0 result l + # (n,result) = sup (size ssuffix) n 0 result ssuffix + = copyLines result n ls + +sup :: !.Int Int !Int *String String -> (Int,.String) +sup l i j s h + | j >= l = (i,s) + #! s = {s & [i] = h.[j]} + = sup l (inc i) (inc j) s h + +substring :: String String -> Bool +substring s1 s2 = ss (fromString s1) (fromString s2) +where + ss :: [Char] [Char] -> Bool + ss p [] = p ==[] + ss p xs = take (length p) xs == p || ss p (tl xs) + +match :: String String -> Bool +match p s = match` (fromString p) (fromString s) +where + match` :: [Char] [Char] -> Bool + match` p [] = all ((==) '*') p + match` [] ss = ss == [] + match` ['*':ps] ss = match` ps ss + || match` ['*' : ps] (tl ss) + match` ['?':ps] [s:ss] = match` ps ss + match` [p :ps] [s:ss] = p==s + && match` ps ss + + + +trim :: String -> String +trim s + | s == "" = "" + | otherwise = s % ((start 0),(end sizeS)) +where end n + | not (isSpace s.[n]) || n <= 0 = n + | otherwise = end (n-1) + + start n + | not (isSpace s.[n]) || n >= sizeS = n + | otherwise = start (n+1) + + sizeS = size s - 1 + +trimQuotes :: String -> String +trimQuotes s + | s == "" = "" + | otherwise = s % ((start 0),(end sizeS)) +where end n + | (s.[n] <> '\'' && s.[n] <> '\"') || n <= 0 = n + | otherwise = end (n-1) + + start n + | (s.[n] <> '\'' && s.[n] <> '\"') || n >= sizeS = n + | otherwise = start (n+1) + + sizeS = size s - 1 + +stringToUpper :: String -> String +stringToUpper cs += {toUpper c \\ c <-: cs} + +stringToLower :: String -> String +stringToLower cs += {toLower c \\ c <-: cs} + +/********************************************************************** + Instances on Maybe: +***********************************************************************/ +instance < (Maybe a) | < a +where (<) (Just a) (Just b) = a < b + (<) Nothing _ = True + (<) _ Nothing = False + +instance toString (Maybe a) | toString a +where toString (Just a) = toString a + toString Nothing = "" + + + +/********************************************************************** + To read all the characters from one File in one readacces + returns: a String containing all characters in a file +***********************************************************************/ +readFile :: *File -> (String, *File) +readFile file + # (ok,file) = fseek file 0 FSeekEnd + | not ok = abort "seek to end of file does not succeed\n" + # (pos,file) = fposition file + # (ok,file) = fseek file (~pos) FSeekCur + | not ok = abort "seek to begin of file does not succeed\n" + # (s, file) = freads file pos + = (s, file) + +/********************************************************************** + To read all the lines from one File + returns: a list of lines without the "\n" +***********************************************************************/ +readStrings :: *File -> ([String], *File) +readStrings file + # (eof, file) = fend file + | eof = ([], file) + # (s, file) = freadline file + # s` = s%(0,size s - 2) + # (ss, file) = readStrings file + | otherwise = ([s` : ss], file) + +/********************************************************************** + To save a list of files: [(fileName,fileContents)] + returns: a list of errors and a new fileenvironment +***********************************************************************/ +exportFiles :: [(String,String)] *Files -> ([String],*Files) +exportFiles [] files + = ([],files) +exportFiles [(fn,fc):htmls] files + # (errors,files) = exportFiles htmls files + # (open,htmlfile,files) = fopen fn FWriteText files + | not open = (["could not open: "+++fn+++"\n" : errors],files) + # (close,files) = (fclose (htmlfile <<< fc)) files + | not close = (["could not close: "+++fn+++"\n" : errors],files) + | otherwise = (errors,files) + +/********************************************************************** + Some funtion from the Haskell prelude: +***********************************************************************/ +// from the Haskell prelude: +(hseq) infixr 0 :: !.a .b -> .b +(hseq) a b = b + +($) infixr 0 +($) f x :== f x + +instance == (Either a b) | == a & == b + where + (==) (Left x) (Left y) = y==x + (==) (Right x) (Right y) = y==x + (==) _ _ = False + +lookup :: a [(a,.b)] -> Maybe .b | == a; +lookup k [] = Nothing +lookup k [(x,y):xys] + | k==x = Just y + | otherwise = lookup k xys + +foldr1 :: (.a -> .(.a -> .a)) ![.a] -> .a; +foldr1 f [x] = x +foldr1 f [x:xs] = f x (foldr1 f xs) + +concatMap :: (.a -> [w:b]) -> u:([.a] -> v:[w:b]), [u <= v, u <= w] +concatMap f = flatten o map f + +fromMaybe :: a (Maybe a) -> a +fromMaybe d Nothing = d +fromMaybe d (Just a) = a + + diff --git a/Http/SubServer/bin/mainserver_eventlog.exe b/Http/SubServer/bin/mainserver_eventlog.exe new file mode 100644 index 0000000000000000000000000000000000000000..d5f4041b28e99f5a7332d227526e8f099f1e4477 Binary files /dev/null and b/Http/SubServer/bin/mainserver_eventlog.exe differ diff --git a/Http/SubServer/bin/remove_subservers_in_registry.exe b/Http/SubServer/bin/remove_subservers_in_registry.exe new file mode 100644 index 0000000000000000000000000000000000000000..a01c0bd3ab9f48ff432fbb120aa7f2b363f8901e Binary files /dev/null and b/Http/SubServer/bin/remove_subservers_in_registry.exe differ diff --git a/Http/SubServer/bin/removesubserver.exe b/Http/SubServer/bin/removesubserver.exe new file mode 100644 index 0000000000000000000000000000000000000000..ccb3aaf2e8e1abd206ac5ed2d56973b61395ce85 Binary files /dev/null and b/Http/SubServer/bin/removesubserver.exe differ diff --git a/Http/SubServer/bin/subservers_in_registry.exe b/Http/SubServer/bin/subservers_in_registry.exe new file mode 100644 index 0000000000000000000000000000000000000000..f966b692462573c666ced881dabc4edb243ac67e Binary files /dev/null and b/Http/SubServer/bin/subservers_in_registry.exe differ diff --git a/Http/SubServer/src/subservers_in_registry/registry.dcl b/Http/SubServer/src/subservers_in_registry/registry.dcl new file mode 100644 index 0000000000000000000000000000000000000000..28b3a12e9d48a4d2fe582b772e3e34dcce8ed86c --- /dev/null +++ b/Http/SubServer/src/subservers_in_registry/registry.dcl @@ -0,0 +1,47 @@ +definition module registry; + +:: RegistryState :== Int; + +KEY_READ:==0x20019; +KEY_SET_VALUE:==2; +KEY_ALL_ACCESS:==0xF002f; + +REG_OPTION_NON_VOLATILE:==0; + +REG_SZ:==1; +REG_BINARY:==3; + +ERROR_SUCCESS:==0; + +HKEY_CURRENT_USER :== 0x80000001; +HKEY_LOCAL_MACHINE :== 0x80000002; + +RegOpenKeyEx :: !Int !{#Char} !Int !Int !RegistryState -> (!Int,!Int,!RegistryState); +RegDeleteKey :: !Int !{#Char} !RegistryState-> (!Int,!RegistryState); +RegCloseKey :: !Int !RegistryState -> (!Int,!RegistryState); +RegCreateKeyEx :: !Int !{#Char} !Int !{#Char} !Int !Int !Int !RegistryState -> (!Int,!Int,!Int,!RegistryState); +RegSetValueEx :: + !Int + !{#Char} + !Int + !Int + !{#Char} + !Int + !RegistryState -> (!Int,!RegistryState); +RegQueryValueEx :: + !Int + !{#Char} + !Int + !Int + !{#Char} + !{#Char} + !RegistryState -> (!Int,!RegistryState); +RegEnumValue :: !Int !Int !Int !Int !Int !RegistryState -> (!Int,!{#Char},!Int,!{#Char},!RegistryState); + +//==> the following don't really belong here... +GetFileAttributes :: !{#Char} -> Int; + +:: CStringP :== Int; + +GetCommandLine :: CStringP; +read_char :: !CStringP -> Char; diff --git a/Http/SubServer/src/subservers_in_registry/registry.icl b/Http/SubServer/src/subservers_in_registry/registry.icl new file mode 100644 index 0000000000000000000000000000000000000000..8a33520ea9e824d0c68102af44a8768f308a0a50 --- /dev/null +++ b/Http/SubServer/src/subservers_in_registry/registry.icl @@ -0,0 +1,126 @@ +implementation module registry; + +import StdArray,StdInt,StdClass,StdString,StdBool,StdChar; + +import code from library "registry_advapi32_library"; + +:: RegistryState :== Int; + +KEY_READ:==0x20019; +KEY_SET_VALUE:==2; +KEY_ALL_ACCESS:==0xF002f; + +REG_OPTION_NON_VOLATILE:==0; + +REG_SZ:==1; +REG_BINARY:==3; + +ERROR_SUCCESS:==0; + +HKEY_LOCAL_MACHINE:==0x80000002; + +RegOpenKeyEx :: !Int !{#Char} !Int !Int !RegistryState -> (!Int,!Int,!RegistryState); +RegOpenKeyEx hkey path n f rs = code { + ccall RegOpenKeyExA@20 "PIsII:II" +}; + +RegDeleteKey :: !Int !{#Char} !RegistryState-> (!Int,!RegistryState); +RegDeleteKey hkey path rs = code { + ccall RegDeleteKeyA@8 "PIs:I" +}; + +RegCloseKey :: !Int !RegistryState -> (!Int,!RegistryState); +RegCloseKey hkey rs = code { + ccall RegCloseKey@4 "PI:I" +}; + +RegCreateKeyEx :: !Int !{#Char} !Int !{#Char} !Int !Int !Int !RegistryState -> (!Int,!Int,!Int,!RegistryState); +RegCreateKeyEx hkey path i s i1 i2 i3 rs = code { + ccall RegCreateKeyExA@36 "PIsIsIII:III" +}; + +RegSetValueEx :: !Int !{#Char} !Int !Int !{#Char} !Int !RegistryState -> (!Int,!RegistryState); +RegSetValueEx hkey s1 i1 i2 s2 i3 rs = code { + ccall RegSetValueExA@24 "PIsIIsI:I" +}; + +RegQueryValueEx :: !Int !{#Char} !Int !Int !{#Char} !{#Char} !RegistryState -> (!Int,!RegistryState); +RegQueryValueEx hkey s1 i1 i2 s2 i3 rs = code { + ccall RegQueryValueExA@24 "PIsIIss:I:I" +}; + +/* +RegEnumValue :: !Int !Int !Int !Int !Int !RegistryState -> (!Int,!{#Char},!Int,!{#Char},!RegistryState); +RegEnumValue key index max_value_name_size reserved max_data_size rs + # value_name = createArray max_value_name_size '0'; + # data = createArray max_data_size '0'; + # type_s = createArray 4 '\0'; + # value_name_size_s = { toChar max_value_name_size, + toChar (max_value_name_size>>8), + toChar (max_value_name_size>>16), + toChar (max_value_name_size>>24) }; + # data_size_s = { toChar max_data_size, + toChar (max_data_size>>8), + toChar (max_data_size>>16), + toChar (max_data_size>>24) }; + # (r,rs) = RegEnumValue_ key index value_name value_name_size_s reserved type_s data data_size_s rs; + | r<>0 + = (r,"",0,"",rs); + # data_size = string4_to_int data_size_s; + # value_name_size = string4_to_int value_name_size_s; + # type = string4_to_int type_s; + | type==REG_SZ && data_size<>0 + = (r,value_name % (0,value_name_size-1),type,data % (0,data_size-2),rs); + = (r,value_name % (0,value_name_size-1),type,data % (0,data_size-1),rs); + +string4_to_int :: !{#Char} -> Int; +string4_to_int s + = toInt s.[0] + (toInt s.[1]<<8) + (toInt s.[2]<<16) + (toInt s.[3]<<24); + +RegEnumValue_ :: !Int !Int !{#Char} !{#Char} !Int !{#Char} !{#Char} !{#Char} !RegistryState -> (!Int,!RegistryState); +RegEnumValue_ key index value_name value_name_size reserved type data data_size rs + = code { + ccall RegEnumValueA@32 "PIIssIsss:I:I" + } +*/ +RegEnumValue :: !Int !Int !Int !Int !Int !RegistryState -> (!Int,!{#Char},!Int,!{#Char},!RegistryState); +RegEnumValue key index max_value_name_size reserved max_data_size rs + # value_name = createArray max_value_name_size '0'; + # data = createArray max_data_size '0'; + # type_s = { 0 }; + # value_name_size_s = { max_value_name_size }; + # data_size_s = { max_data_size }; + # (r,rs) = RegEnumValue_ key index value_name value_name_size_s reserved type_s data data_size_s rs; + | r<>0 + = (r,"",0,"",rs); + # data_size = data_size_s.[0]; + # value_name_size = value_name_size_s.[0]; + # type = type_s.[0]; + | type==REG_SZ && data_size<>0 + = (r,value_name % (0,value_name_size-1),type,data % (0,data_size-2),rs); + = (r,value_name % (0,value_name_size-1),type,data % (0,data_size-1),rs); + +RegEnumValue_ :: !Int !Int !{#Char} !{#Int} !Int !{#Int} !{#Char} !{#Int} !RegistryState -> (!Int,!RegistryState); +RegEnumValue_ key index value_name value_name_size reserved type data data_size rs + = code { + ccall RegEnumValueA@32 "PIIsAIAsA:I:I" + } + +GetFileAttributes :: !{#Char} -> Int; +GetFileAttributes file_name = code { + ccall GetFileAttributesA@4 "Ps:I" +}; + +:: CStringP :== Int; + +GetCommandLine :: CStringP; +GetCommandLine = code { + ccall GetCommandLineA@0 "P:I" +}; + +read_char :: !CStringP -> Char; +read_char p = code { + instruction 15 + instruction 182 + instruction 0 | movzx eax,byte ptr [eax] +}; diff --git a/Http/SubServer/src/subservers_in_registry/remove_subservers_in_registry.icl b/Http/SubServer/src/subservers_in_registry/remove_subservers_in_registry.icl new file mode 100644 index 0000000000000000000000000000000000000000..fb458eee46565d15a0fd3799e6829c01c8dd8365 --- /dev/null +++ b/Http/SubServer/src/subservers_in_registry/remove_subservers_in_registry.icl @@ -0,0 +1,30 @@ +module remove_subservers_in_registry; + +import StdEnv,registry; + +REGLOCATION :== "SOFTWARE\\Clean HTTP\0"; + +ERROR_FILE_NOT_FOUND:== 2; +ERROR_ACCESS_DENIED :== 5; + +Start w + # rs=0; + # (stdout,w) = stdio w; + # (r,key,rs) = RegOpenKeyEx HKEY_LOCAL_MACHINE REGLOCATION 0 KEY_ALL_ACCESS rs; + | r==ERROR_FILE_NOT_FOUND + # stdout = fwrites "No subservers are stored in the registry\n" stdout; + = snd (fclose stdout w); + + | r<>0 + | r==ERROR_ACCESS_DENIED + = abort ("RegOpenKeyEx failed with error code "+++toString r+++" (access denied)"); + = abort ("RegOpenKeyEx failed with error code "+++toString r); + # (r,rs) = RegCloseKey key rs; + | r<>0 + = abort ("RegCloseKey failed with error code "+++toString r); + # (r,rs) = RegDeleteKey HKEY_LOCAL_MACHINE REGLOCATION rs; + | r<>0 + = abort ("RegDeleteKey failed with error code "+++toString r); + + # stdout = fwrites "The subservers have been removed from the registry\n" stdout; + = snd (fclose stdout w); diff --git a/Http/SubServer/src/subservers_in_registry/remove_subservers_in_registry.prj b/Http/SubServer/src/subservers_in_registry/remove_subservers_in_registry.prj new file mode 100644 index 0000000000000000000000000000000000000000..e51b119bc4047541ed956d25fc5493c0ff2ff40b --- /dev/null +++ b/Http/SubServer/src/subservers_in_registry/remove_subservers_in_registry.prj @@ -0,0 +1,473 @@ +Version: 1.4 +Global + Built: True + Target: StdEnv + Exec: {Project}\remove_subservers_in_registry.exe + CodeGen + CheckStacks: False + CheckIndexes: True + Application + HeapSize: 409600 + StackSize: 102400 + ExtraMemory: 81920 + IntialHeapSize: 204800 + HeapSizeMultiplier: 4096 + ShowExecutionTime: False + ShowGC: False + ShowStackSize: False + MarkingCollector: False + StandardRuntimeEnv: True + Profile + Memory: False + MemoryMinimumHeapSize: 0 + Time: False + Stack: False + Output + Output: NoReturnType + Font: Courier + FontSize: 9 + WriteStdErr: False + Link + LinkMethod: Static + GenerateRelocations: False + GenerateLinkMap: False + LinkResources: False + ResourceSource: + GenerateDLL: False + ExportedNames: + Paths + Path: {Project} + Precompile: + Postlink: +MainModule + Name: remove_subservers_in_registry + Dir: {Project} + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + Icl + WindowPosition + X: 10 + Y: 10 + SizeX: 817 + SizeY: 640 + IclOpen: True + LastModified: No 0 0 0 0 0 0 +OtherModules + Module + Name: registry + Dir: {Project} + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + Dcl + WindowPosition + X: 10 + Y: 10 + SizeX: 800 + SizeY: 640 + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + NeededLibraries + Library: registry_advapi32_library + Module + Name: StdFunc + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: StdCharList + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: StdTuple + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: StdOrdList + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: _SystemEnum + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: StdEnum + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: StdList + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: StdFile + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: StdString + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: StdReal + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: _SystemArray + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: StdArray + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: StdClass + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: StdChar + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: StdMisc + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: StdInt + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: StdOverloaded + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: StdBool + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: StdEnv + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 +Static + Mods + Path: {Project}\remove_subservers_in_registry.icl + Path: {Project}\registry.icl + Path: {Application}\Libraries\StdEnv\StdFunc.icl + Path: {Application}\Libraries\StdEnv\StdCharList.icl + Path: {Application}\Libraries\StdEnv\StdTuple.icl + Path: {Application}\Libraries\StdEnv\StdOrdList.icl + Path: {Application}\Libraries\StdEnv\_SystemEnum.icl + Path: {Application}\Libraries\StdEnv\StdEnum.icl + Path: {Application}\Libraries\StdEnv\StdList.icl + Path: {Application}\Libraries\StdEnv\StdFile.icl + Path: {Application}\Libraries\StdEnv\StdString.icl + Path: {Application}\Libraries\StdEnv\StdReal.icl + Path: {Application}\Libraries\StdEnv\_SystemArray.icl + Path: {Application}\Libraries\StdEnv\StdArray.icl + Path: {Application}\Libraries\StdEnv\StdClass.icl + Path: {Application}\Libraries\StdEnv\StdChar.icl + Path: {Application}\Libraries\StdEnv\StdMisc.icl + Path: {Application}\Libraries\StdEnv\StdInt.icl + Path: {Application}\Libraries\StdEnv\StdOverloaded.icl + Path: {Application}\Libraries\StdEnv\StdBool.icl + Path: {Application}\Libraries\StdEnv\StdEnv.icl + Objs + Path: {Application}\Libraries\StdEnv\Clean System Files\_startup0.o + Path: {Application}\Libraries\StdEnv\Clean System Files\_startup1.o + Path: {Application}\Libraries\StdEnv\Clean System Files\_startup2.o + Path: {Application}\Libraries\StdEnv\Clean System Files\_system.o + Path: {Project}\Clean System Files\remove_subservers_in_registry.o + Path: {Project}\Clean System Files\registry.o + Path: {Application}\Libraries\StdEnv\Clean System Files\StdFunc.o + Path: {Application}\Libraries\StdEnv\Clean System Files\StdCharList.o + Path: {Application}\Libraries\StdEnv\Clean System Files\StdTuple.o + Path: {Application}\Libraries\StdEnv\Clean System Files\StdOrdList.o + Path: {Application}\Libraries\StdEnv\Clean System Files\_SystemEnum.o + Path: {Application}\Libraries\StdEnv\Clean System Files\StdEnum.o + Path: {Application}\Libraries\StdEnv\Clean System Files\StdList.o + Path: {Application}\Libraries\StdEnv\Clean System Files\StdFile.o + Path: {Application}\Libraries\StdEnv\Clean System Files\StdString.o + Path: {Application}\Libraries\StdEnv\Clean System Files\StdReal.o + Path: {Application}\Libraries\StdEnv\Clean System Files\_SystemArray.o + Path: {Application}\Libraries\StdEnv\Clean System Files\StdArray.o + Path: {Application}\Libraries\StdEnv\Clean System Files\StdClass.o + Path: {Application}\Libraries\StdEnv\Clean System Files\StdChar.o + Path: {Application}\Libraries\StdEnv\Clean System Files\StdMisc.o + Path: {Application}\Libraries\StdEnv\Clean System Files\StdInt.o + Path: {Application}\Libraries\StdEnv\Clean System Files\StdOverloaded.o + Path: {Application}\Libraries\StdEnv\Clean System Files\StdBool.o + Path: {Application}\Libraries\StdEnv\Clean System Files\StdEnv.o + Dlib + Path: {Application}\Libraries\StdEnv\Clean System Files\kernel_library + Path: {Application}\Libraries\StdEnv\Clean System Files\user_library + Path: {Application}\Libraries\StdEnv\Clean System Files\gdi_library + Path: {Application}\Libraries\StdEnv\Clean System Files\comdlg_library + Path: {Project}\Clean System Files\registry_advapi32_library + Pths + Path: {Project} + Path: {Application}\Libraries\StdEnv + AppP: D:\John\Clean 2.2 + PrjP: D:\John\c\CleanHttpServer\subservers_in_registry diff --git a/Http/SubServer/src/subservers_in_registry/subservers_in_registry.icl b/Http/SubServer/src/subservers_in_registry/subservers_in_registry.icl new file mode 100644 index 0000000000000000000000000000000000000000..3c8e06f206efee5a5c313a2e0d3d4408bc32718c --- /dev/null +++ b/Http/SubServer/src/subservers_in_registry/subservers_in_registry.icl @@ -0,0 +1,43 @@ +module subservers_in_registry; + +import StdEnv,registry; + +REGLOCATION :== "SOFTWARE\\Clean HTTP\0"; + +ERROR_FILE_NOT_FOUND:== 2; +ERROR_ACCESS_DENIED :== 5; +ERROR_NO_MORE_ITEMS :== 259; + +Start w + # rs=0; + # (stdout,w) = stdio w; + # (r,key,rs) = RegOpenKeyEx HKEY_LOCAL_MACHINE REGLOCATION 0 KEY_ALL_ACCESS rs; + | r==ERROR_FILE_NOT_FOUND + # stdout = fwrites "No subservers are stored in the registry\n" stdout; + = snd (fclose stdout w); + | r<>0 + | r==ERROR_ACCESS_DENIED + = abort ("RegOpenKeyEx failed with error code "+++toString r+++" (access denied)"); + = abort ("RegOpenKeyEx failed with error code "+++toString r); + + # (data,rs) = read_key_data_strings key 0 rs; + # (r,rs) = RegCloseKey key rs; + | r<>0 + = abort ("RegCloseKey failed with error code "+++toString r); + | isEmpty data + # stdout = fwrites "No subservers are stored in the registry\n" stdout; + = snd (fclose stdout w); + # stdout = fwrites "The following subservers are stored in the registry:\n" stdout; + # stdout = foldl (\f s -> fwritec '\n' (fwrites s f)) stdout data; + = snd (fclose stdout w); + +read_key_data_strings key index rs + # (r,value_name,type,data,rs) = RegEnumValue key index 256 0 4096 rs; + | r==ERROR_NO_MORE_ITEMS + = ([],rs); + | r<>0 + = abort ("RegEnumValue failed with error code "+++toString r); + | type==REG_SZ + # (more_data,rs) = read_key_data_strings key (index+1) rs; + = ([data:more_data],rs); + = read_key_data_strings key (index+1) rs; diff --git a/Http/SubServer/src/subservers_in_registry/subservers_in_registry.prj b/Http/SubServer/src/subservers_in_registry/subservers_in_registry.prj new file mode 100644 index 0000000000000000000000000000000000000000..0fa080c013027fe7402db428dc9de153d7e4786d --- /dev/null +++ b/Http/SubServer/src/subservers_in_registry/subservers_in_registry.prj @@ -0,0 +1,497 @@ +Version: 1.4 +Global + Built: True + Target: StdEnv + Exec: {Project}\subservers_in_registry.exe + CodeGen + CheckStacks: False + CheckIndexes: True + Application + HeapSize: 409600 + StackSize: 102400 + ExtraMemory: 81920 + IntialHeapSize: 204800 + HeapSizeMultiplier: 4096 + ShowExecutionTime: False + ShowGC: False + ShowStackSize: False + MarkingCollector: False + StandardRuntimeEnv: True + Profile + Memory: False + MemoryMinimumHeapSize: 0 + Time: False + Stack: False + Output + Output: NoReturnType + Font: Courier + FontSize: 9 + WriteStdErr: False + Link + LinkMethod: Static + GenerateRelocations: False + GenerateLinkMap: False + LinkResources: False + ResourceSource: + GenerateDLL: False + ExportedNames: + Paths + Path: {Project} + Precompile: + Postlink: +MainModule + Name: subservers_in_registry + Dir: {Project} + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + Icl + WindowPosition + X: 141 + Y: 42 + SizeX: 837 + SizeY: 566 + IclOpen: True + LastModified: No 0 0 0 0 0 0 +OtherModules + Module + Name: StdEnv + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: StdBool + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: StdOverloaded + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: StdInt + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: StdMisc + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: StdChar + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: StdClass + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: StdArray + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: _SystemArray + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: StdReal + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: StdString + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: StdFile + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + Dcl + WindowPosition + X: 10 + Y: 10 + SizeX: 800 + SizeY: 640 + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: StdList + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + Dcl + WindowPosition + X: 10 + Y: 10 + SizeX: 800 + SizeY: 640 + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: StdEnum + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: _SystemEnum + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: StdOrdList + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: StdTuple + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + Dcl + WindowPosition + X: 10 + Y: 10 + SizeX: 800 + SizeY: 640 + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: StdCharList + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: StdFunc + Dir: {Application}\Libraries\StdEnv + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + DclOpen: False + IclOpen: False + LastModified: No 0 0 0 0 0 0 + Module + Name: registry + Dir: {Project} + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False + Dcl + WindowPosition + X: 10 + Y: 10 + SizeX: 800 + SizeY: 640 + DclOpen: False + Icl + WindowPosition + X: 141 + Y: 11 + SizeX: 837 + SizeY: 618 + IclOpen: False + LastModified: No 0 0 0 0 0 0 + NeededLibraries + Library: registry_advapi32_library +Static + Mods + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\CleanServer\subservers_in_registry\subservers_in_registry.icl + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\StdEnv.icl + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\StdBool.icl + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\StdOverloaded.icl + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\StdInt.icl + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\StdMisc.icl + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\StdChar.icl + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\StdClass.icl + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\StdArray.icl + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\_SystemArray.icl + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\StdReal.icl + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\StdString.icl + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\StdFile.icl + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\StdList.icl + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\StdEnum.icl + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\_SystemEnum.icl + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\StdOrdList.icl + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\StdTuple.icl + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\StdCharList.icl + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\StdFunc.icl + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\CleanServer\subservers_in_registry\registry.icl + Objs + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\Clean System Files\_startup0.o + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\Clean System Files\_startup1.o + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\Clean System Files\_startup2.o + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\Clean System Files\_system.o + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\CleanServer\subservers_in_registry\Clean System Files\subservers_in_registry.o + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\CleanServer\subservers_in_registry\Clean System Files\registry.o + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\Clean System Files\StdFunc.o + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\Clean System Files\StdCharList.o + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\Clean System Files\StdTuple.o + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\Clean System Files\StdOrdList.o + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\Clean System Files\_SystemEnum.o + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\Clean System Files\StdEnum.o + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\Clean System Files\StdList.o + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\Clean System Files\StdFile.o + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\Clean System Files\StdString.o + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\Clean System Files\StdReal.o + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\Clean System Files\_SystemArray.o + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\Clean System Files\StdArray.o + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\Clean System Files\StdClass.o + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\Clean System Files\StdChar.o + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\Clean System Files\StdMisc.o + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\Clean System Files\StdInt.o + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\Clean System Files\StdOverloaded.o + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\Clean System Files\StdBool.o + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\Clean System Files\StdEnv.o + Dlib + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\Clean System Files\kernel_library + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\Clean System Files\user_library + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\Clean System Files\gdi_library + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv\Clean System Files\comdlg_library + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\CleanServer\subservers_in_registry\Clean System Files\registry_advapi32_library + Pths + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\CleanServer\subservers_in_registry + Path: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\StdEnv + AppP: D:\John\Clean 2.2 + PrjP: D:\John\c\CleanHttpServer\subservers_in_registry