+ Added ezcgi class from Michael Hess

fcl/inc/ezcgi.pp

@@ -0,0 +1,392 @@
+unit ezcgi;
+
+{$mode delphi}
+{$H+ }
+
+interface
+
+uses classes, strings, sysutils;
+
+const
+   hexTable = '0123456789ABCDEF';
+
+type
+   ECGIException = class(Exception);
+
+   TEZcgi = class(TObject)
+   private
+      { Private declarations }
+      FVariables : TStringList;
+      FName : String;
+      FEmail : String;
+      FQueryString : String;
+
+      { Token variables }
+      aString : String;
+      aSepStr : String;
+      aPos    : Byte;
+      aLenStr : Byte;
+      aLenSep : Byte;
+
+      procedure InitToken(aStr, aSep : String);
+      function NextToken(var aToken : String; var aSepChar : Char) : Boolean;
+
+      procedure GetQueryItems;
+      procedure ProcessRequest;
+      procedure LoadEnvVariables;
+      function GetVal(Index : String) : String;      
+      function GetName(Index : Integer) : String;      
+      function GetVariable(Index : Integer) : String;      
+      function GetVarCount : Integer;
+      procedure ReadPostQuery;
+      procedure ReadGetQuery;
+   protected
+      { Protected declarations }
+
+      procedure OutputError(errorMessage : String);
+   public
+      { Public declarations }
+      constructor Create;
+      destructor Destroy; override;
+      procedure Run;
+      procedure WriteContent(ctype : String);
+      procedure PutLine(sOut : String);
+      function GetValue(Index : String; defaultValue : String) : String;
+      
+      procedure DoPost; virtual;
+      procedure DoGet; virtual;
+
+      property Values[Index : String] : String read GetVal;
+      property Names[Index : Integer] : String read GetName;
+      property Variables[Index : Integer] : String read GetVariable;
+      property VariableCount : Integer read GetVarCount;
+      
+      property Name : String read FName write FName;
+      property Email : String read FEmail write FEmail;
+   end;
+
+implementation
+
+{ *********** Include OS-dependent Getenv Call ************ }
+
+{$I ezcgi.inc}
+
+{ *********** Public Methods *************** }
+
+constructor TEZcgi.Create;
+begin
+   FName := 'No name available';
+   FEmail := 'Email address unavailable';
+
+   FVariables := TStringList.Create;
+
+   LoadEnvVariables;
+   
+end;
+
+destructor TEZcgi.Destroy;
+begin
+   FVariables.Free;
+end;
+
+procedure TEZcgi.Run;
+begin
+   ProcessRequest;
+end;
+
+procedure TEZcgi.DoPost;
+begin
+  // Must be overriden by child class
+end;
+
+procedure TEZcgi.DoGet;
+begin
+  // Must be overriden by child class
+end;
+
+procedure TEZcgi.WriteContent(ctype : String);
+begin
+   writeln('Content-Type: ',ctype);
+   writeln;
+end;
+
+procedure TEZcgi.PutLine(sOut : String);
+begin
+   writeln(sOut);
+end;
+
+function TEZcgi.GetValue(Index, defaultValue : String) : String;
+begin
+   result := GetVal(Index);
+   if result = '' then
+      result := defaultValue;
+end;
+
+
+{ *********** Private Methods *************** }
+
+procedure TEZcgi.LoadEnvVariables;
+
+   procedure GetEData(variable : String);
+   var
+      tempStr : String;
+   begin
+      // This is a system dependent call !!
+      tempStr := GetEnv(variable);
+      if tempStr <> '' then
+         FVariables.Add(variable + '=' + tempStr);
+   end;
+
+begin
+
+   { Standard CGI Environment Variables }
+   GetEData('AUTH_TYPE');
+   GetEData('CONTENT_LENGTH');
+   GetEData('CONTENT_TYPE');
+   GetEData('GATEWAY_INTERFACE');
+   GetEData('PATH_INFO');
+   GetEData('PATH_TRANSLATED');
+   GetEData('QUERY_STRING');
+   GetEData('REMOTE_ADDR');
+   GetEData('REMOTE_HOST');
+   GetEData('REMOTE_IDENT');
+   GetEData('REMOTE_USER');
+   GetEData('REQUEST_METHOD');
+   GetEData('SCRIPT_NAME');
+   GetEData('SERVER_NAME');
+   GetEData('SERVER_PORT');
+   GetEData('SERVER_PROTOCOL');
+   GetEData('SERVER_SOFTWARE');
+
+
+   { Standard HTTP Environment Variables }
+   GetEData('HTTP_ACCEPT');
+   GetEData('HTTP_ACCEPT_CHARSET');
+   GetEData('HTTP_ACCEPT_ENCODING');
+   GetEData('HTTP_IF_MODIFIED_SINCE');
+   GetEData('HTTP_REFERER');
+   GetEData('HTTP_USER_AGENT');
+end;
+
+procedure TEZcgi.ProcessRequest;
+var
+   request : String;
+begin
+
+   request := GetVal('REQUEST_METHOD');
+   
+   if request = '' then
+      OutputError('No REQUEST_METHOD passed from server!')
+   else if request = 'POST' then
+   begin
+      ReadPostQuery;
+      DoPost;
+   end
+   else if request = 'GET' then
+      begin
+         ReadGetQuery;
+	 DoGet;
+      end
+   else
+      OutputError('Invalid REQUEST_METHOD passed from server!');
+end;
+
+function TEZcgi.GetVal(Index : String) : String;
+begin
+   result := FVariables.Values[Index];
+end;
+
+function TEZcgi.GetName(Index : Integer) : String;
+begin
+   result := FVariables.Names[Index];
+end;
+
+function TEZcgi.GetVariable(Index : Integer) : String;
+begin
+   result := FVariables[Index];
+end;
+
+function TEZcgi.GetVarCount : Integer;
+begin
+   result := FVariables.Count;
+end;
+
+procedure TEZcgi.ReadPostQuery;
+var
+   index : Integer;
+   ch : Char;
+   temp : String;
+   code : Word;
+   contentLength : Integer;
+   theType : String;
+      
+begin
+
+   temp := GetVal('CONTENT_LENGTH');
+   if Length(temp) > 0 then
+   begin
+      Val(temp, contentLength, code);
+      if code <> 0 then
+         contentLength := 0;
+   end;
+
+   if contentLength = 0 then
+      OutputError('No content length passed from server!');
+
+   theType := UpperCase(GetVal('CONTENT_TYPE'));
+
+   if theType <> 'APPLICATION/X-WWW-FORM-URLENCODED' then
+      OutputError('No content type passed from server!');
+
+   FQueryString := '';
+
+   for index := 0 to contentLength do
+   begin
+      Read(ch);
+      FQueryString := FQueryString + ch;
+   end;
+
+   GetQueryItems;
+end;
+
+procedure TEZcgi.ReadGetQuery;
+begin
+   FQueryString := GetVal('QUERY_STRING');
+
+   if FQueryString = '' then
+      OutputError('No QUERY_STRING passed from server!');
+
+   GetQueryItems;
+end;
+
+procedure TEZcgi.GetQueryItems;
+var
+   queryItem : String;
+   delimiter : Char;
+
+   function hexConverter(h1, h2 : Char) : Char;
+   var
+      thex : byte;
+   begin
+      tHex := (Pos(upcase(h1), hexTable) - 1) * 16;
+      tHex := tHex + Pos(upcase(h2), hexTable) - 1;
+
+      result := chr(thex);
+   end;
+
+   procedure Convert_ESC_Chars;
+   var
+      index : Integer;
+   begin
+      repeat
+         index := Pos('+', queryItem);
+	 if index > 0 then
+	    queryItem[index] := Chr(32);
+      until index = 0;
+      repeat
+         index := Pos('%', queryItem);
+	 if index > 0 then
+	 begin
+	    queryItem[index] := hexConverter(queryItem[index + 1], queryItem[index + 2]);
+	    system.Delete(queryItem, index + 1, 2);
+	 end;
+      until index = 0;
+   end;
+
+begin
+   InitToken(FQueryString, '&');
+   
+   while NextToken(queryItem, delimiter) do
+   begin
+      if queryItem <> '' then
+      begin
+         Convert_ESC_Chars;
+         FVariables.Add(queryItem);
+      end;
+   end;
+end;
+
+procedure TEZcgi.OutputError(errorMessage : String);
+begin
+   WriteContent('text/html');
+   writeln('<html><head><title>CGI ERROR</title></head>');
+   writeln('<body>');
+   writeln('<center><hr><h1>CGI ERROR</h1><hr></center><br><br>');
+   writeln('This CGI application encountered the following error: <br>');
+   writeln('<ul><br>');
+   writeln('<li> error: ',errorMessage,'<br><hr>'); 
+   writeln('<h5><p><i>Notify ',FName,' <a href="mailto:',FEmail,'">',FEmail,'</a></i></p></h5>');
+   writeln('</body></html>');
+
+   Raise ECGIException.Create(errorMessage);
+end;
+
+procedure TEZcgi.InitToken(aStr, aSep : String);
+begin
+     aString := aStr;
+     aSepStr := aSep;
+     aPos    := 1;
+     aLenStr := Length(aString);
+     aLenSep := Length(aSepStr);
+end;
+
+function TEZcgi.NextToken(var aToken : String; var aSepChar : Char) : Boolean;
+var
+   i : Byte;
+   j : Byte;
+   BoT : Byte;
+   EoT : Byte;
+   isSep : Boolean;
+
+begin
+   BoT := aPos;
+   EoT := aPos;
+   for i := aPos to aLenStr do
+   begin
+      IsSep := false;
+      for j := 1 to aLenSep do
+      begin
+         if aString[i] = aSepStr[j] then
+         begin
+            IsSep := true;
+            Break;
+         end;
+      end;
+      if IsSep then
+      begin
+         EoT  := i;
+         aPos := i + 1;
+         aSepChar := aString[i];
+         Break;
+      end
+      else
+      begin
+         if i = aLenStr then
+         begin
+            EoT  := i;
+            aPos := i;
+            Break;
+         end;
+      end;
+   end;
+   if aPos < aLenStr then
+   begin
+      aToken := Copy(aString, BoT, EoT - BoT);
+      Result := true;
+   end
+   else
+   begin
+      if aPos = aLenStr then
+      begin
+         aToken := Copy(aString, BoT, EoT - BoT + 1);
+         Result := true;
+         aPos   := aPos + 1;
+      end
+      else
+      begin
+         Result := false;
+      end;
+   end;
+end;
+
+end.

fcl/linux/ezcgi.inc

@@ -0,0 +1,16 @@
+Uses Linux;
+
+{ Declared EXPLICITLY with Ansistring, so NO mistaking is possible }
+
+Function Getenv (Var EnvVar  : AnsiString): AnsiString;
+
+Var P : Pchar;
+
+begin
+   // Linux version returns pchar.
+   p:=linux.getenv(EnvVar);
+   if P<>'' then
+     getenv:=ansistring(p)
+   else
+     getenv:='';
+end;

fcl/win32/ezcgi.inc

@@ -0,0 +1,34 @@
+Uses Windows;
+
+{ Declared EXPLICITLY with Ansistring, so NO mistaking is possible }
+
+{
+  This function is VERY inefficient, but the downsize would be to
+  have initialization/finalization code to get/free the environment
+  settings.
+}
+
+Function Getenv (Var EnvVar  : AnsiString): AnsiString;
+
+var
+   s : string;
+   i : longint;
+   hp,p : pchar;
+begin
+   getenv:='';
+   p:=GetEnvironmentStrings;
+   hp:=p;
+   while hp^<>#0 do
+     begin
+        s:=AnsiString(hp);
+        i:=pos('=',s);
+        if upcase(copy(s,1,i-1))=upcase(envvar) then
+          begin
+             getenv:=copy(s,i+1,length(s)-i);
+             break;
+          end;
+        { next string entry}
+        hp:=hp+strlen(hp)+1;
+     end;
+   FreeEnvironmentStrings(p);
+end;