Changeset 86 for branches/DirectWeb/UHTTPServer.pas

Timestamp:

Dec 17, 2009, 8:25:15 AM (15 years ago)

Author:

george

Message:

• Přidáno: Zobrazení ServerInfo.
• Přidáno: Zpracování HTTP Cookies.

File:

• branches/DirectWeb/UHTTPServer.pas (modified) (10 diffs)

branches/DirectWeb/UHTTPServer.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, UTCPServer, UCommon, UMemoryStreamEx, UMIMEType;
+  Classes, SysUtils, UTCPServer, UCommon, UMemoryStreamEx, UMIMEType,
+  Synautil;
 
 type
 
-  { TQueryString }
-
-  TQueryString = class(TStringList)
-    procedure Parse(QueryString: string);
+  TQueryParameterList = class(TStringList)
+    procedure Parse(Text: string);
     function Syntetize: string;
   end;
 
+  { TCookieList }
+
+  TCookieList = class(TStringList)
+    procedure Parse(Text: string);
+    function Syntetize: string;
+  end;
+
   { THTTPRequest }
 
   THTTPRequest = class
-    Query: TQueryString;
+    Query: TQueryParameterList;
     Path: string;
     Host: string;
     Method: string;
+    Headers: TStringList;
+    Cookies: TCookieList;
     constructor Create;
     destructor Destroy; override;
@@ -34 +42 @@
     Stream: TMemoryStreamEx;
     Headers: TStringList;
+    Cookies: TCookieList;
     constructor Create;
     destructor Destroy; override;
@@ -78 +87 @@
   RequestHandler: TRequestHandler;
   Line: string;
+  LineIndex: Integer;
   LineParts: array of string;
   Request: THTTPRequest;
@@ -90 +100 @@
     Response.Headers.Values['Server'] := Name;
     Request := THTTPRequest.Create;
+    LineIndex := 0;
     repeat
       Line := RecvString(10000);
       LineParts := Explode(' ', Line);
-      if Length(LineParts) > 0 then begin
-        if (LineParts[0] = 'GET') or (LineParts[0] = 'HEAD') or
-        (LineParts[0] = 'POST') then begin
-          if Pos('?', LineParts[1]) > 0 then begin
-            Request.Path := Copy(LineParts[1], 1, Pos('?', LineParts[1]) - 1);
-            Request.Query.Parse(Copy(LineParts[1], Pos('?', LineParts[1]) + 1, Length(LineParts[1])));
-          end else Request.Path := LineParts[1];
-          Request.Method := LineParts[0];
-        end else
-        if LineParts[0] = 'Host:' then Request.Host := LineParts[1];
+      if (LineIndex = 0) and (Length(LineParts) >= 3) then begin
+        Request.Method := LineParts[0];
+        if Pos('?', LineParts[1]) > 0 then begin
+          Request.Path := Copy(LineParts[1], 1, Pos('?', LineParts[1]) - 1);
+          Request.Query.Parse(Copy(LineParts[1], Pos('?', LineParts[1]) + 1, Length(LineParts[1])));
+        end else Request.Path := LineParts[1];
+      end else
+      if (Length(LineParts) >= 2) and (LineParts[0][Length(LineParts[0])] = ':') then begin
+        LineParts[0] := Copy(LineParts[0], 1, Length(LineParts[0]) - 1);
+        Request.Headers.Values[LineParts[0]] := LineParts[1];
       end;
+      Inc(LineIndex);
     until Line = '';
 
+    // Parse cookies
+    if Request.Cookies.IndexOfName('Cookie') <> -1 then
+    Request.Cookies.Parse(Request.Headers.Values['Cookie']);
+
     Response.Stream.Clear;
+    Response.Headers.Values['Content-Type'] := 'text/html';
+
     WriteLn('Requested path: ' + Request.Path);
     RequestHandler := RequestHandlerList.IndexOfName(Request.Path);
@@ -115 +133 @@
     with Response do begin
       SendString('HTTP/1.0 200 OK'#13#10);
-      SendString('Content-Length: ' + IntToStr(Stream.Size) + #13#10);
-      SendString('Connection: close'#13#10);
-      //SendString('Date: ' + RFC822DateTime(Now) + #13#10);
-      // Send additional headers
+      Headers.Values['Content-Length'] := IntToStr(Stream.Size);
+      Headers.Values['Connection'] := 'close';
+      Headers.Values['Date'] := RFC822DateTime(Now);
+
+      // Handle cookies
+      for I := 0 to Cookies.Count - 1 do
+        Headers.Values['Set-Cookie'] := Cookies.Names[I] + '=' + Cookies.ValueFromIndex[I];
+        // + ';path=/;expires=' + RFC822DateTime(Now);
+
+      // Send headers
       for I := 0 to Headers.Count - 1 do
         SendString(Headers.Names[I] + ': ' + Headers.ValueFromIndex[I] + #13#10);
@@ -180 +204 @@
 begin
   Stream := TMemoryStreamEx.Create;
+  Cookies := TCookieList.Create;
   Headers := TStringList.Create;
-  Headers.Values['Content-Type'] := 'text/html';
 end;
 
@@ -214 +238 @@
 constructor THTTPRequest.Create;
 begin
-  Query := TQueryString.Create;
+  Query := TQueryParameterList.Create;
+  Headers := TStringList.Create;
+  Cookies := TCookieList.Create;
 end;
 
@@ -220 +246 @@
 begin
   Query.Destroy;
+  Headers.Destroy;
   inherited Destroy;
 end;
 
-{ TQueryString }
-
-procedure TQueryString.Parse(QueryString: string);
+{ TQueryParameterList }
+
+procedure TQueryParameterList.Parse(Text: string);
 var
   I: Integer;
@@ -231 +258 @@
   Pair: TArrayOfString;
 begin
-  Parts := Explode('&', QueryString);
+  Clear;
+  Parts := Explode('&', Text);
   for I := 0 to Length(Parts) - 1 do begin
     Pair := Explode('=', Parts[I]);
-    Values[Pair[0]] := Pair[1];
-  end;
-end;
-
-function TQueryString.Syntetize: string;
+    if Length(Pair) >= 2 then
+      Values[Pair[0]] := Pair[1];
+  end;
+end;
+
+function TQueryParameterList.Syntetize: string;
 var
   I: Integer;
@@ -246 +275 @@
     Result := Result + '&amp;' + Names[I] + '=' + ValueFromIndex[I];
   Result := Copy(Result, 6, Length(Result));
-
+end;
+
+{ TCookieList }
+
+procedure TCookieList.Parse(Text: string);
+var
+  I: Integer;
+  Parts: TArrayOfString;
+  Pair: TArrayOfString;
+begin
+  Clear;
+  Parts := Explode(';', Text);
+  for I := 0 to Length(Parts) - 1 do begin
+    Pair := Explode('=', Parts[I]);
+    if Length(Pair) >= 2 then
+      Values[Trim(Pair[0])] := Trim(Pair[1]);
+  end;
+end;
+
+function TCookieList.Syntetize: string;
+var
+  I: Integer;
+begin
+  Result := '';
+  for I := 0 to Count - 1 do
+    Result := Result + '; ' + Names[I] + '=' + ValueFromIndex[I];
+  Result := Copy(Result, 2, Length(Result));
 end;