MODULE Main;

IMPORT
  ClientClass, CVProto, ErrMsg, File, FilePosix, FileWr, Fmt, FS, FSServer,
  IO, IP, Logger, OSError, OSErrorPosix, Params, Pathname,
  Process, RCSComp, RegularFile, Stdio, SupMisc, SysLogger, Text, Thread,
  TimeStampLogger, TokScan, TreeComp, Unix, UnixMisc, Version, WrLogger;

CONST
  ThreadStackSize = 16 * 1024;  (* In units of Word.T *)

VAR
  mainPid: Process.ID;
  config := NEW(FSServer.Configuration);

PROCEDURE BecomeDaemon()
  RAISES {OSError.E} =
  BEGIN
    WITH pid = Unix.fork() DO
      IF pid = -1 THEN  (* Error. *)
	OSErrorPosix.Raise()
      ELSIF pid # 0 THEN  (* Parent process. *)
	Unix.underscore_exit(0);
      END;
    END;

    (* This is the child process. *)

    IF UnixMisc.SetSID() = -1 THEN
      OSErrorPosix.Raise();
    END;

    (* EVAL Unix.chdir(SupMisc.RootDir);  FIXME - Not yet. *)
  END BecomeDaemon;

PROCEDURE CheckPort(port: INTEGER): IP.Port =
  BEGIN
    IF port = IP.NullPort
    OR NOT (FIRST(IP.Port) <= port AND port <= LAST(IP.Port)) THEN
      ErrMsg.Fatal("Invalid port " & Fmt.Int(port));
    END;
    IF port < 1024 THEN
      ErrMsg.Fatal("Reserved port " & Fmt.Int(port) & " not permitted");
    END;
    RETURN port;
  END CheckPort;

PROCEDURE FetchArg(VAR argNum, argPos: CARDINAL): TEXT =
  VAR
    arg := Params.Get(argNum);
    argLen := Text.Length(arg);
    value: TEXT;
  BEGIN
    IF argPos < argLen THEN  (* There was no whitespace after the flag. *)
      value := Text.Sub(arg, argPos);
      argPos := argLen;
    ELSE  (* The value is in a separate argument. *)
      INC(argNum);
      IF argNum >= Params.Count THEN
	Usage();
      END;
      value := Params.Get(argNum);
    END;
    RETURN value;
  END FetchArg;

PROCEDURE GoingDown() =

Called (hopefully) when process is killed or crashes.

  BEGIN
    IF config.logger # NIL AND Process.GetMyID() = mainPid THEN
      Logger.Notice(config.logger, "Going down");
    END;
  END GoingDown;

PROCEDURE Redirect(in, out, err: File.T) =
  BEGIN
    IF in # NIL THEN EVAL Unix.dup2(in.fd, 0) END;
    IF out # NIL THEN EVAL Unix.dup2(out.fd, 1) END;
    IF err # NIL THEN EVAL Unix.dup2(err.fd, 2) END;
  END Redirect;

PROCEDURE Usage(msg: TEXT := NIL) =
  VAR
    prog := Pathname.Last(Params.Get(0));
  BEGIN
    IF msg # NIL THEN
      msg := msg & "\n";
    ELSE
      msg := "";

    END;
    ErrMsg.Fatal(msg
      & "Usage: " & prog & " [options]"
      & "\n  Options:"
      & "\n    -A addr         Listen for connections on a specific address"
      & "\n    -b base         Base configuration directory (default " &
                                  SupMisc.DefaultServerBase & ")"
      & "\n    -c collDirs     Colon-separated search path for collections,"
				  & " relative"
      & "\n                      to base (default \""
				  & SupMisc.DefaultServerCollDir & "\")"
      & "\n    -C maxClients   Max. simultaneous clients (default 1 then exit)"
      & "\n    -e              Don't close standard error and standard output"
				  & " files"
      & "\n    -f              Don't become a daemon, even if -C is specified"
      & "\n    -l log          Log file, or \"@facility\" (e.g., " &
				  "\"@local0\") to use syslog"
      & "\n    -p port         Alternate TCP/IP port (default " &
				  Fmt.Int(SupMisc.Port) & ")"
      & "\n    -P range        Range for server data port in passive mode"
      & "\n                    (default unrestricted).  Range can be a single"
      & "\n                    port number, or a range \"lo-hi\"."
      & "\n    -s scanDir      Directory where scan files can be found " &
				 "(default none)"
      & "\n    -v              Print version and exit"
      & "\n    -x              Require detailed compare for all RCS files"
      & "\n    -Z compLevel    Compression level (0..9, default " &
				  Fmt.Int(SupMisc.DefaultCompression) & ")"
      );
  END Usage;

VAR
  justPrintVersion := FALSE;
  logName: Pathname.T := NIL;
  logFile: File.T := NIL;
  devNull, outFile : File.T := NIL;
  noFork := FALSE;
  keepStderr := FALSE;
  argNum: CARDINAL;
  argPos: CARDINAL;
  argLen: CARDINAL;
  option: CHAR;
  arg: TEXT;
  argVal: TEXT;
  pos: INTEGER;
  server: FSServer.T;
BEGIN
  TRY
    TRY
      argNum := 1;
      WHILE argNum < Params.Count DO
	arg := Params.Get(argNum);
	argLen := Text.Length(arg);
	IF argLen > 0 AND Text.GetChar(arg, 0) = '-' THEN
	  argPos := 1;
	  WHILE argPos < argLen DO
	    option := Text.GetChar(arg, argPos);
	    INC(argPos);
	    CASE option OF
	    | 'A' =>
		WITH t = FetchArg(argNum, argPos) DO
		  TRY
		    IF NOT SupMisc.ParseHost(t, config.localEndpoint.addr) THEN
		      ErrMsg.Fatal(t & ": host unknown");
		    END
		  EXCEPT IP.Error(list) =>
		    ErrMsg.Fatal(t & ": " & ErrMsg.StrError(list));
		  END;
		END;
	    | 'b' =>
		config.serverBase := FetchArg(argNum, argPos);
	    | 'c' =>
		config.serverCollDirs := FetchArg(argNum, argPos);
	    | 'C' =>
		config.maxChildren := TokScan.AtoI(FetchArg(argNum, argPos));
	    | 'd' =>
                WITH level = TokScan.AtoI(FetchArg(argNum, argPos)) DO
                  ClientClass.debugLevel := level;
                  TreeComp.traceLevel := level;
                  RCSComp.traceLevel := level;
                END;
	    | 'f' => noFork := TRUE;
	    | 'e' => keepStderr := TRUE;
	    | 'l' => logName := FetchArg(argNum, argPos);
	    | 'p' =>
		config.localEndpoint.port :=
		  CheckPort(TokScan.AtoI(FetchArg(argNum, argPos)));
	    | 'P' =>
		argVal := FetchArg(argNum, argPos);
		pos := Text.FindChar(argVal, '-');
		IF pos >= 0 THEN
		  config.loDataPort :=
		    CheckPort(TokScan.AtoI(Text.Sub(argVal, 0, pos),
		    "low data port"));
		  config.hiDataPort :=
		    CheckPort(TokScan.AtoI(Text.Sub(argVal, pos+1),
		    "high data port"));
		  IF config.loDataPort > config.hiDataPort THEN
		    ErrMsg.Fatal("Invalid data port range " & argVal);
		  END;
		ELSE
		  config.loDataPort :=
		    CheckPort(TokScan.AtoI(argVal, "data port"));
		  config.hiDataPort := config.loDataPort;
		END;
	    | 's' =>
		config.serverScanDir := FetchArg(argNum, argPos);
	    | 't' =>
                WITH level = TokScan.AtoI(FetchArg(argNum, argPos)) DO
                  TreeComp.traceLevel := level;
                  RCSComp.traceLevel := level;
                END;
	    | 'v' => justPrintVersion := TRUE;
	    | 'x' => config.detailAllRCSFiles := TRUE;
	    | 'Z' =>
		WITH val = TokScan.AtoI(FetchArg(argNum, argPos)) DO
		  IF 0 <= val AND val <= 9 THEN
		    config.compLevel := val;
		  ELSE
		    ErrMsg.Fatal("Compression level out of range 0..9");
		  END;
		END;
	    ELSE
	      Usage("Invalid option \"-" & Text.FromChar(option) & "\"");
	    END;
	  END;
	ELSE
	  Usage();
	END;
	INC(argNum);
      END;
    EXCEPT TokScan.Error(msg) =>
      Usage(msg);
    END;

    IF justPrintVersion THEN
      IO.Put("CVSup server\n");
      IO.Put("Copyright 1996-2003 John D. Polstra\n");
      IO.Put("Software version: " & Version.Name & "\n");
      IO.Put("Protocol version: " & Fmt.Int(CVProto.Current.major) & "." &
	Fmt.Int(CVProto.Current.minor) & "\n");
      IO.Put("Operating system: " & Version.Target & "\n");
      IO.Put("http://www.cvsup.org/\n");
      IO.Put("Report problems to cvsup-bugs@polstra.com\n");
      IO.Put("CVSup is a registered trademark of John D. Polstra\n");
      Process.Exit(0);
    END;

    IF logName # NIL THEN
      IF Text.Length(logName) > 0 AND Text.GetChar(logName, 0) = '@' THEN
	(* Log to a syslog facility. *)
	TRY
	  WITH facility = SysLogger.DecodeFacility(Text.Sub(logName, 1)) DO
	    config.logger := NEW(SysLogger.T).init("cvsupd", facility,
	      SysLogger.Options{SysLogger.Option.Pid});
	  END;
	EXCEPT SysLogger.Error(msg) =>
	  ErrMsg.Fatal(msg);
	END;
      ELSE  (* Log to a file. *)
	TRY
	  logFile := FS.OpenFile(logName, truncate := FALSE);
	  TYPECASE logFile OF
	  | RegularFile.T(reg) =>
	      EVAL reg.seek(RegularFile.Origin.End, 0);
	      UnixMisc.AppendAlways(logFile);
	  ELSE (* Ignore *) END;
	  WITH logWr = NEW(FileWr.T).init(logFile) DO
	    config.logger := NEW(WrLogger.T).init(logWr);
	    config.logger := NEW(TimeStampLogger.T).init(config.logger);
	  END;
	EXCEPT OSError.E(l) =>
	  ErrMsg.Fatal("Cannot create \"" & logName & "\"", l);
	END;
      END;
    ELSIF config.maxChildren < 0 THEN  (* Once-only mode. *)
      config.logger := NEW(WrLogger.T).init(Stdio.stdout);
      config.logger := NEW(TimeStampLogger.T).init(config.logger);
    END;

    (* Increase the default stack size for all threads. *)
    Thread.MinDefaultStackSize(ThreadStackSize);

    server := NEW(FSServer.T).init(config);

    IF config.maxChildren >= 0 AND NOT noFork THEN  (* Become a daemon. *)
      TRY
	BecomeDaemon();

	(* Redirect stdin, stdout, and stderr. *)
	devNull := FS.OpenFile(SupMisc.DevNull,
	  truncate := FALSE,
	  create := FS.CreateOption.Never);
	TRY
	  IF logFile # NIL THEN  (* Logging to a file *)
	    outFile := logFile;
	  ELSIF keepStderr THEN
	    outFile := NIL;
	  ELSE
	    outFile := devNull;
	  END;
	  Redirect(in := devNull, out := outFile, err := outFile);
	FINALLY
	  IF devNull.fd > 2 THEN
	    devNull.close();
	  END;
	END;
      EXCEPT OSError.E(l) =>
	ErrMsg.Fatal("Cannot become a daemon", l);
      END;
    END;

    mainPid := Process.GetMyID();
    Process.RegisterExitor(GoingDown);

    server.run();
  EXCEPT
  | FSServer.Error(msg) =>
      ErrMsg.Fatal(msg);
  | Thread.Alerted =>
      ErrMsg.Fatal("Interrupted");
  END;
END Main.