MODULEClientLog logs the message to the client (through; <* PRAGMA LL *> IMPORT App, ConnRW, FloatMode, Fmt, HTTP, IP, Lex, Rd, RdUtils, TCP, TCPPeer, Text, TextExtras, TextRd, Thread, Wr; HTTPApp
wr
) and
to the application log (through log
)
TYPE ClientLog = App.Log OBJECT appLog: App.Log; wr: Wr.T; msg: TEXT; serverPush: BOOLEAN; OVERRIDES log := MessageLog; END; PROCEDUREMessageLog (self: ClientLog; msg: TEXT; status: App.LogStatus) RAISES {App.Error} = BEGIN IF status = App.LogStatus.Error THEN IF self.serverPush THEN self.msg := Fmt.F("%s%s\n", self.msg, msg); ServerPushFrame(self.wr, "text/plain", self.msg, self.appLog); ELSE TRY Wr.PutText(self.wr, msg); Wr.PutText(self.wr, "\n"); EXCEPT | Wr.Failure, Thread.Alerted => self.appLog.log( "Error sending message to client", App.LogStatus.Error); END; END; END; self.appLog.log(msg, status); END MessageLog; PROCEDUREWrLog (old: App.Log; wr: Wr.T; serverPush: BOOLEAN := FALSE): App.Log = BEGIN RETURN NEW(ClientLog, appLog := old, wr := wr, msg := "", serverPush := serverPush); END WrLog; VAR readWriteMu := NEW(MUTEX); readWriteCV := NEW(Thread.Condition); readingCnt := 0; writingCnt := 0; (* single writer, multiple reader algorithm. if a thread is writing, then writingCnt # 0. if a thread is reading, then readingCnt # 0. a thread can read if another thread is reading. a thread cannot read if another thread is writing. a thread can write if no thread is reading or writing. readingCnt and writingCnt are protected by readWriteMu. *) PROCEDUREReadLock () = BEGIN LOCK readWriteMu DO WHILE writingCnt # 0 DO Thread.Wait(readWriteMu, readWriteCV); END; INC(readingCnt); END; END ReadLock; PROCEDUREReadUnlock () = BEGIN LOCK readWriteMu DO DEC(readingCnt); END; END ReadUnlock; PROCEDUREWriteLock () = BEGIN LOCK readWriteMu DO WHILE readingCnt # 0 OR writingCnt # 0 DO Thread.Wait(readWriteMu, readWriteCV); END; INC(writingCnt); END; END WriteLock; PROCEDUREWriteUnlock () = BEGIN LOCK readWriteMu DO DEC(writingCnt); END; END WriteUnlock; REVEAL RequestHandler = RequestHandlerPublic BRANDED "HTTPApp.RequestHandler" OBJECT port: INTEGER; OVERRIDES accept := DefaultAccept; request := DefaultRequest; END; PROCEDUREDefaultAccept (<* UNUSED *> self : RequestHandler; <* UNUSED *> request : HTTP.Request; <* UNUSED *> serverData : REFANY; <* UNUSED *> VAR acceptState: REFANY; <* UNUSED *> log : App.Log ): BOOLEAN = BEGIN <* ASSERT FALSE *> END DefaultAccept; PROCEDUREDefaultRequest (<* UNUSED *> self: RequestHandler; <* UNUSED *> request: HTTP.Request; <* UNUSED *> serverData, acceptState: REFANY; <* UNUSED *> rd: Rd.T; <* UNUSED *> wr: Wr.T; <* UNUSED *> log: App.Log) = BEGIN <* ASSERT FALSE *> END DefaultRequest; REVEAL ReplyHandler = ReplyHandlerPublic BRANDED "HTTPApp.ReplyHandler" OBJECT OVERRIDES reply := DefaultReply; END; PROCEDUREDefaultReply (<* UNUSED *> self: ReplyHandler; <* UNUSED *> reply: HTTP.Reply; <* UNUSED *> rd: Rd.T; <* UNUSED *> wr: Wr.T; <* UNUSED *> log: App.Log) = BEGIN <* ASSERT FALSE *> END DefaultReply; REVEAL Proxy = ProxyPublic BRANDED "HTTPApp.Proxy" OBJECT OVERRIDES init := InitProxy; add := AddProxy; END; PROCEDUREInitProxy (self: Proxy): Proxy = BEGIN self.rules := NIL; self.tail := NIL; RETURN self; END InitProxy; CONST NotComma = SET OF CHAR{'\000' .. '\377'} - SET OF CHAR{','}; PROCEDUREAddProxy (self: Proxy; ruleTxt: TEXT; log: App.Log) RAISES {App.Error} = VAR rd := TextRd.New(ruleTxt); rule := NEW(ProxyRules); prev: ServerList := NIL; host: TEXT; BEGIN IF log = NIL THEN log := App.defaultLog; END; TRY rule.hostPattern := Lex.Scan(rd); IF Text.Length(rule.hostPattern) = 0 OR Text.GetChar( rule.hostPattern, Text.Length(rule.hostPattern) - 1) = '\\' THEN log.log( Fmt.F("Bad pattern (%s) in hostPattern proxy(s) value: \"%s\"", rule.hostPattern, ruleTxt), App.LogStatus.Error); END; TRY LOOP Lex.Skip(rd); host := Lex.Scan(rd, NotComma); IF Text.Length(host) > 0 THEN WITH server = NEW(ServerList, head := NEW(Server).initParse(host, log), tail := NIL) DO IF prev = NIL THEN prev := server; rule.proxy := prev; ELSE prev.tail := server; prev := prev.tail END; END; END; EVAL Rd.GetChar(rd); END; EXCEPT | Rd.EndOfFile => END; EXCEPT | Rd.Failure, Thread.Alerted => log.log(Fmt.F("Bad urlPattern:proxy value: \"%s\"", ruleTxt), App.LogStatus.Error); END; IF self.tail = NIL THEN self.rules := rule; ELSE self.tail.tail := rule; END; self.tail := rule; END AddProxy; REVEAL Server = ServerPublic BRANDED "HTTPApp.Server" OBJECT OVERRIDES init := InitServer; initParse := InitParseServer; END; PROCEDUREInitServer (self : Server; server: TEXT; port : INTEGER; log : App.Log ): Server RAISES {App.Error} = VAR addr: IP.Address; BEGIN IF Text.Equal(server, "DIRECT") THEN self.server := NIL ELSE self.server := server; self.port := port; self.endpoint := IP.NullEndPoint; TRY IF NOT IP.GetHostByName(server, addr) THEN log.log(Fmt.F("Cannot find %s", server), App.LogStatus.Status); RETURN self; END; EXCEPT | IP.Error => log.log(Fmt.F("Cannot find %s", server), App.LogStatus.Status); RETURN self; END; self.endpoint := IP.Endpoint{addr := addr, port := port}; END; RETURN self; END InitServer; CONST NonColon = SET OF CHAR{'\000'..'\377'} - SET OF CHAR{':'}; NonSlash = SET OF CHAR{'\000'..'\377'} - SET OF CHAR{'/'}; PROCEDUREInitParseServer (self: Server; serverAndPort: TEXT; log: App.Log): Server RAISES {App.Error} = VAR server: TEXT; port := 0; BEGIN IF Text.Equal(serverAndPort, "DIRECT") THEN server := "DIRECT"; ELSE WITH rd = TextRd.New(serverAndPort) DO TRY server := Lex.Scan(rd, NonColon); IF Text.Equal(server, "http") THEN WITH url = NEW(HTTP.URL).init(serverAndPort, log) DO server := url.host; port := url.port; END; ELSE IF NOT Rd.EOF(rd) THEN EVAL Rd.GetChar(rd); port := Lex.Int(rd); END; END; EXCEPT | Lex.Error, FloatMode.Trap, Rd.EndOfFile, Rd.Failure, Thread.Alerted => log.log( Fmt.F("Bad server and port given: \"%s\" (need server:port)", serverAndPort), App.LogStatus.Error); END; END; END; RETURN self.init(server, port, log); END InitParseServer; TYPE RequestHandlerList = REF RECORD head: RequestHandler; tail: RequestHandlerList; END; VAR requestHandlerList: RequestHandlerList := NIL; PROCEDUREFindRequestHandler ( request : HTTP.Request; serverData : REFANY; VAR (* OUT *) acceptState : REFANY; port, service: INTEGER; log : App.Log ): RequestHandler RAISES {App.Error} = VAR list: RequestHandlerList; BEGIN ReadLock(); TRY IF requestHandlerList = NIL THEN RETURN NIL END; FOR i := FIRST(RequestPriority) TO LAST(RequestPriority) DO list := requestHandlerList; REPEAT IF list.head.priority = i AND (list.head.port = service OR list.head.port = port OR list.head.port = AnyPort) AND list.head.accept(request, serverData, acceptState, log) THEN RETURN list.head END; list := list.tail; UNTIL list = NIL; END; FINALLY ReadUnlock(); END; RETURN NIL; END FindRequestHandler; TYPE Closure = Thread.Closure OBJECT client: TCP.T; log : App.Log; wrLog : BOOLEAN; data : REFANY; port, service : INTEGER; OVERRIDES apply := ServerHandler; END; PROCEDUREGetNameDontCrash (host: TCP.T): TEXT RAISES {IP.Error} = VAR res := TCPPeer.GetName(host); BEGIN IF res = NIL THEN WITH ep = TCPPeer.Get(host) DO RETURN Fmt.F("%s.%s.%s.%s", Fmt.Int(ep.addr.a[0]), Fmt.Int(ep.addr.a[1]), Fmt.Int(ep.addr.a[2]), Fmt.Int(ep.addr.a[3])); END; END; RETURN res END GetNameDontCrash; PROCEDUREServerHandler (cl: Closure): REFANY = VAR rd : Rd.T; wr : Wr.T; request : HTTP.Request; requestHandler: RequestHandler; acceptState : REFANY; BEGIN TRY TRY rd := ConnRW.NewRd(cl.client); wr := ConnRW.NewWr(cl.client); IF cl.wrLog THEN cl.log := WrLog(cl.log, wr, FALSE); END; request := NEW(HTTP.Request).parse(rd, cl.log); IF Text.Length(request.url.host) = 0 THEN request.url.host := App.GetHostName(); request.url.port := cl.port; END; IF App.Verbose() THEN cl.log.log(Fmt.F("INCOMING REQUEST: %s", request.toText(NIL, TRUE, cl.log)), App.LogStatus.Verbose); ELSIF App.Debug() THEN TRY cl.log.log(Fmt.F("%s %s", GetNameDontCrash(cl.client), request.url.toText()), App.LogStatus.Debug); EXCEPT | IP.Error => END; END; requestHandler := FindRequestHandler(request, cl.data, acceptState, cl.port, cl.service, cl.log); IF requestHandler # NIL THEN requestHandler.request( request, cl.data, acceptState, rd, wr, cl.log); ELSE TRY HTTP.WriteSimpleReplyHeader( wr, NIL, cl.log, HTTP.StatusCode[HTTP.StatusType.Not_Found], HTTP.StatusReason[HTTP.StatusType.Not_Found]); Wr.PutText(wr, "Content-type: text/plain\r\n\r\n"); Wr.PutText(wr, Fmt.F("The requested item: %s was not found\n", request.url.toText())); EXCEPT | Wr.Failure, Thread.Alerted => END; END; FINALLY TRY Wr.Close(wr); EXCEPT | Wr.Failure, Thread.Alerted => END; TRY Rd.Close(rd); EXCEPT | Rd.Failure, Thread.Alerted => END; Thread.Pause(30.0d0); TCP.Close(cl.client); END; EXCEPT | App.Error => END; RETURN NIL; END ServerHandler; TYPE ServerPorts = REF RECORD port, service: INTEGER; next: ServerPorts; END; VAR serverPorts: ServerPorts := NIL; <* LL = readWriteMu *> PROCEDUREServerPort (port, service: INTEGER): BOOLEAN = VAR sp: ServerPorts; BEGIN LOCK readWriteMu DO sp := serverPorts; WHILE sp # NIL DO IF sp.port = port AND (sp.service = service OR sp.service = AnyService) THEN RETURN TRUE; END; sp := sp.next; END; RETURN FALSE; END; END ServerPort; PROCEDUREServe (port, serviceValue: INTEGER; log: App.Log; data: REFANY) RAISES {App.Error} = VAR conn : TCP.T; connector: TCP.Connector; nilLog := log = NIL; BEGIN LOCK readWriteMu DO serverPorts := NEW(ServerPorts, port := port, service := serviceValue, next := serverPorts); END; IF log = NIL THEN log := App.defaultLog END; TRY connector := TCP.NewConnector( IP.Endpoint{addr := IP.NullAddress, port := port}); EXCEPT | IP.Error (cause) => log.log("IP.Error making connector: " & RdUtils.FailureText(cause), App.LogStatus.Error); RETURN; END; log.log( Fmt.F("Listening on port: %s", Fmt.Int(port)), App.LogStatus.Status); LOOP TRY conn := TCP.Accept(connector); EVAL Thread.Fork( NEW(Closure, client := conn, log := log, wrLog := nilLog, data := data, port := port, service := serviceValue)); EXCEPT | IP.Error, Thread.Alerted => (* continue *) END; END; END Serve; PROCEDUREDirect (request: HTTP.Request; log: App.Log): TCP.T RAISES {App.Error} = VAR server := NEW(Server).init(request.url.host, request.url.port, log); BEGIN TRY RETURN TCP.Connect(server.endpoint); EXCEPT | IP.Error, Thread.Alerted => log.log(Fmt.F("Unable to connect to server: %s:%s", server.server, Fmt.Int(server.port)), App.LogStatus.Error); END; <* ASSERT FALSE *> END Direct; PROCEDUREClient ( request : HTTP.Request; proxy : Proxy; style : HTTP.Style; rdClient: Rd.T; wrClient: Wr.T; handler : ReplyHandler; <* UNUSED *> service : INTEGER; log : App.Log ) RAISES {App.Error} = VAR conn : TCP.T; wrServer : Wr.T; rdServer : Rd.T; rules : ProxyRules; proxyRequest: BOOLEAN := FALSE; proxies : ServerList; hp : TEXT; BEGIN IF log = NIL THEN log := App.defaultLog END; IF style = NIL THEN style := HTTP.DefaultStyle() END; IF App.Verbose() THEN log.log( Fmt.F("OUTGOING request: %s", request.toText(style, TRUE, log)), App.LogStatus.Verbose); END; IF Text.Length(request.url.host) = 0 THEN log.log(Fmt.F("No server given in requested URL: %s", request.url.toText()), App.LogStatus.Error); END; IF proxy = NIL THEN conn := Direct(request, log); ELSE rules := proxy.rules; hp := Fmt.F("%s:%s", request.url.host, Fmt.Int(request.url.port)); WHILE rules # NIL AND conn = NIL DO IF TextExtras.PatternMatch(hp, rules.hostPattern) THEN IF App.Verbose() THEN IF rules.proxy.head.server = NIL THEN log.log(Fmt.F("proxy rule matched: %s %s DIRECT", Fmt.F("%s:%s", request.url.host, Fmt.Int(request.url.port)), rules.hostPattern), App.LogStatus.Verbose); ELSE log.log( Fmt.F("proxy rule matched: %s %s %s", Fmt.F("%s:%s", request.url.host, Fmt.Int(request.url.port)), rules.hostPattern, rules.proxy.head.server), App.LogStatus.Verbose); END; END; proxies := rules.proxy; WHILE proxies # NIL DO WITH server = proxies.head DO IF server.server = NIL THEN conn := Direct(request, log); EXIT; ELSE TRY IF server.endpoint = IP.NullEndPoint THEN (* try to resolve another time *) EVAL server.init(server.server, server.port, log); END; conn := TCP.Connect(server.endpoint); proxyRequest := TRUE; EXIT; EXCEPT | IP.Error, Thread.Alerted => log.log( Fmt.F("Unable to connect to proxy server: %s:%s", server.server, Fmt.Int(server.port)), App.LogStatus.Status); END; END; END; proxies := proxies.tail; END; END; rules := rules.tail; END; IF conn = NIL THEN log.log(Fmt.F("proxy rule matched: %s DIRECT (default)", Fmt.F("%s:%s", request.url.host, Fmt.Int(request.url.port))), App.LogStatus.Verbose); conn := Direct(request, log); END; END; wrServer := ConnRW.NewWr(conn); rdServer := ConnRW.NewRd(conn); TRY TRY TRY request.write(wrServer, style, proxyRequest, log); IF rdClient # NIL AND request.method = HTTP.Method.Post AND request.postData # NIL THEN Wr.PutText(wrServer, request.postData); END; FINALLY (* SCG/MSM 2/22/96 A CERN proxy gets confused if we close the wr while still using the rd. Symptoms: Sending large files though the cern proxy fail partway through. The reader blocks on a read and the socket is in FIN_WAIT_2. *) Wr.Flush(wrServer); END; WITH reply = NEW(HTTP.Reply).parse(rdServer, log) DO IF App.Verbose() THEN log.log(reply.toText(NIL, log), App.LogStatus.Verbose); END; handler.reply(reply, rdServer, wrClient, log); END; FINALLY Wr.Close(wrServer); Rd.Close(rdServer); TCP.Close(conn); END; EXCEPT | Rd.Failure, Thread.Alerted, Wr.Failure => log.log(Fmt.F("error get url: %s", request.url.toText()), App.LogStatus.Error); END; END Client; PROCEDURERegisterRequestHandler (port: INTEGER; handler: RequestHandler) = BEGIN WriteLock(); TRY handler.port := port; requestHandlerList := NEW(RequestHandlerList, head := handler, tail := requestHandlerList); FINALLY WriteUnlock(); END; END RegisterRequestHandler; PROCEDUREServerPushSupported (request: HTTP.Request): BOOLEAN = VAR field := request.lookupField("User-Agent"); trd: TextRd.T; agent: TEXT; BEGIN TRY IF field # NIL THEN trd := TextRd.New(field.value); agent := Lex.Scan(trd, NonSlash); IF Text.Equal(agent, "Mozilla") THEN RETURN TRUE END; END; EXCEPT | Rd.Failure, Thread.Alerted => END; RETURN FALSE; END ServerPushSupported; PROCEDUREServerPushFrame (wr: Wr.T; contentType, msg: TEXT; log: App.Log) RAISES {App.Error} = BEGIN TRY IF App.Verbose() THEN log.log(Fmt.F("Serverpush: %s", msg), App.LogStatus.Verbose); END; Wr.PutText(wr, ServerPushBoundaryStringStart); Wr.PutText(wr, Fmt.F("Content-type: %s\r\nContent-length: %s\r\n\r\n", contentType, Fmt.Int(Text.Length(msg)))); Wr.PutText(wr, msg); Wr.Flush(wr); EXCEPT | Wr.Failure, Thread.Alerted => IF App.Debug() THEN log.log(Fmt.F("Failure writing \"%s\" server push frame", msg), App.LogStatus.Debug); END; END; END ServerPushFrame; VAR proxy: Proxy := NEW(Proxy).init(); PROCEDUREDefaultProxy (<* UNUSED *> log: App.Log): Proxy = BEGIN RETURN proxy; END DefaultProxy; TYPE Arg = {ProxyServer}; ArgHandler = App.ArgHandler OBJECT OVERRIDES set := SetArg; END; PROCEDURESetArg ( self : ArgHandler; <*UNUSED *> src : App.ArgSource; value: TEXT; log : App.Log ) RAISES {App.Error} = BEGIN CASE VAL(self.id, Arg) OF | Arg.ProxyServer => IF Text.Length(value) > 0 THEN proxy.add(value, log); END; END; END SetArg; BEGIN EVAL NEW(ArgHandler, id := ORD(Arg.ProxyServer), paramName := "pattern ProxyServer:port|DIRECT", default := "").init( switchName := "proxy", envName := "HTTP_PROXY", configName := "proxy"); END HTTPApp.