comanche.sd7

(********************************************************************)
(*                                                                  *)
(*  comanche.sd7  Simple webserver for static and cgi pages.        *)
(*  Copyright (C) 2009 - 2017, 2023  Thomas Mertes                  *)
(*                                                                  *)
(*  This program is free software; you can redistribute it and/or   *)
(*  modify it under the terms of the GNU General Public License as  *)
(*  published by the Free Software Foundation; either version 2 of  *)
(*  the License, or (at your option) any later version.             *)
(*                                                                  *)
(*  This program is distributed in the hope that it will be useful, *)
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of  *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the   *)
(*  GNU General Public License for more details.                    *)
(*                                                                  *)
(*  You should have received a copy of the GNU General Public       *)
(*  License along with this program; if not, write to the           *)
(*  Free Software Foundation, Inc., 51 Franklin Street,             *)
(*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
(*                                                                  *)
(********************************************************************)


$ include "seed7_05.s7i";
  include "propertyfile.s7i";
  include "httpserv.s7i";
  include "x509cert.s7i";
  include "osfiles.s7i";
  include "http_response.s7i";


const string: htdocsDefault is "../htdocs";
const string: cgiDirDefault is "../prg";
const string: cgiNameDefault is "/cgi-bin/";


const proc: main is func
  local
    var string: htdocs is htdocsDefault;
    var string: cgiDir is cgiDirDefault;
    var string: cgiName is cgiNameDefault;
    var string: envFileName is "";
    var array string: args is 0 times "";
    var integer: index is 0;
    var boolean: writeHelp is FALSE;
    var boolean: useTls is FALSE;
    var boolean: htdocsAssigned is FALSE;
    var boolean: cgiDirAssigned is FALSE;
    var boolean: envFileNameAssigned is FALSE;
    var integer: slashPos is 0;
    var propertyDataType: cgiEnvironment is propertyDataType.value;
    var string: envKey is "";
    var string: envValue is "";
    var boolean: okay is TRUE;
    var integer: port is 1080;
    var httpServer: server is httpServer.value;
    var httpRequest: request is httpRequest.value;
    var httpResponseData: responseData is httpResponseData.value;
  begin
    writeln("Comanche Version 2.0 - Simple webserver for static and cgi pages");
    writeln("Copyright (C) 2009 - 2017, 2023 Thomas Mertes");
    writeln("This is free software; see the source for copying conditions.  There is NO");
    writeln("warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.");
    writeln("Comanche is written in the Seed7 programming language");
    writeln("Homepage: http://seed7.sourceforge.net");
    args := argv(PROGRAM);
    for key index range argv(PROGRAM) do
      if args[index] in {"-h", "-?"} then
        writeHelp := TRUE;
      elsif args[index] = "-p" and index < length(args) then
        block
          port := integer(args[succ(index)]);
        exception
          catch RANGE_ERROR:
            writeln(" ***** Port not numeric. Port " <& port <& " used instead.");
        end block;
        incr(index);
      elsif args[index] = "-c" and index < length(args) then
        cgiName := args[succ(index)];
        incr(index);
      elsif args[index] = "-tls" then
        useTls := TRUE;
      elsif not htdocsAssigned then
        htdocs := convDosPath(args[index]);
        htdocsAssigned := TRUE;
      elsif not cgiDirAssigned then
        cgiDir := convDosPath(args[index]);
        cgiDirAssigned := TRUE;
      elsif not envFileNameAssigned then
        envFileName := convDosPath(args[index]);
        envFileNameAssigned := TRUE;
      else
        writeln(" ***** Unrecognized parameter " <& args[index] <& ".");
      end if;
    end for;
    if writeHelp then
      writeln;
      writeln("usage: comanche [-h | -?] [-p port] [-c cgi-name] [-tls] [html-dir [cgi-dir [env-file]]]");
      writeln;
      writeln("Options:");
      writeln("  -h  or  -?   Write usage information.");
      writeln("  -p port      Specify the port (default: 1080).");
      writeln("  -c cgi-name  Specify the cgi-name used in the HTTP(S) requests (default: " <&
              literal(cgiNameDefault) <& ").");
      writeln("               If cgi-name is \"\" the cgi-name is taken from cgi-dir.");
      writeln("  -tls         Use HTTPS instead of HTTP.");
      writeln("Parameters:");
      writeln("  html-dir     The root directory for HTML files (default: " <&
              literal(htdocsDefault) <& ").");
      writeln("  cgi-dir      The root directory for CGI scripts (default: " <&
              literal(cgiDirDefault) <& ").");
      writeln("  env-file     Property file with environment variables to be defined.");
    else
      if cgiName = "" then
        slashPos := rpos(cgiDir, "/");
        if slashPos = 0 then
          cgiName := "/" & cgiDir & "/";
        else
          cgiName := cgiDir[slashPos ..] & "/";
        end if;
      end if;
      responseData := httpResponseData(htdocs, cgiDir, cgiName, osFiles);
      if fileType(responseData.backendSys, responseData.htdocs) <> FILE_DIR then
        writeln(" *** Directory " <& literal(responseData.htdocs) <& " not found.");
        writeln("     You need to specify a directory which contains");
        writeln("     at least \"index.htm\" and possibly other HTML files.");
        okay := FALSE;
      end if;
      if fileType(responseData.backendSys, responseData.cgiDir) <> FILE_DIR then
        writeln(" *** Directory " <& literal(responseData.cgiDir) <& " not found.");
        writeln("     You need to specify a directory which contains");
        writeln("     executable CGI scripts.");
        okay := FALSE;
      end if;
      if envFileNameAssigned then
        if fileType(envFileName) <> FILE_REGULAR then
          writeln(" *** File " <& literal(envFileName) <& " not found.");
        else
          cgiEnvironment := readPropertyFile(envFileName);
          for envValue key envKey range cgiEnvironment do
            setenv(envKey, envValue);
          end for;
        end if;
      end if;
      if not okay then
        writeln("Use the option -? (or -h) to get more information.");
      else
        chdir(responseData.cgiDir);
        writeln("HTML directory: " <& responseData.htdocs);
        writeln("CGI directory: " <& responseData.cgiDir);
        writeln("CGI name: " <& responseData.cgiName);
        writeln("Port: " <& port);
        server := openHttpServer(port, stdCertificate, useTls);
        writeln("To test comanche make sure that " <&
                literal(responseData.htdocs & "/index.htm") <& " exists and");
        write("open http");
        if useTls then
          write("s");
        end if;
        writeln("://localhost:" <& port <& "/ in your browser. \
                \To stop comanche press CTRL-C.");
        while TRUE do
          request := getHttpRequest(server);
          # writeln(request.method <& " " <& request.path);
          if request.method = "GET" then
            processGet(responseData, request);
          elsif request.method = "POST" then
            processPost(responseData, request);
          else
            sendClientError(request.sock, 405, "Method Not Allowed",
                "The HTTP-method " <& request.method <& " is not allowed.");
          end if;
          # process(request);
        end while;
      end if;
    end if;
  end func;