/*
 *      CVSENV.CMD - NOSA Administrator V1.10 - cla@clanganke.de - 1999-2008
 *
 *     Syntax: cvsenv [archive_name] [command]
 *
 *       archive_name - name of the archive directory
 *
 *     Commands can start with the following characters: $/- (like: $Bin /Bin -Bin)
 *     Valid commands are (lowercase letters optional):
 *     (no option)|$Work   - brings you to the working directory of a project
 *     $Bin                - brings you back to the bin directory of NOSAADM
 *     $Archive            - brings you to the archive directory tree of a project
 *     $List               - lists all available archives and their publicity status
 *     $Edit cfgtype       - loads a given system or NOSA config file into TEDIT
 *                           valid types are: Rc,Service,Inet,Archivelist, Privatelist
 *     $Init [comment]     - sets up and initialises a new archive
 *     $REInit [comment]   - resets to an empty archive (includes $CLEARWORK)
 *     $COMment [comment]  - sets the archive comment
 *     $Private            - restrict an archive to private access
 *     $PUblic             - open private archive to public access
 *     $CLearwork          - empties working directory completely
 *     $Delete             - removes all directories for a given archive.
 *     $IMport zipname     - imports files from within a zip archive file
 *                           NOTE: working directory must be empty !
 *     $Secure             - installs security for an archive
 *                           If no comment is specified, cvsenv will prompt for one
 *     $BAckup             - creates a backup zip file of the archive within
 *                           directory <CVS_BACKUPROOT>\<archive_name>. Specifiying
 *                           a '*' as archive name will backup all archives.
 *     $SNapshot [tagname] - creates snapshot zip file within directory
 *                           <CVS_SNAPSHOTROOT>\<archive_name>, existing zip
 *                           files are replaced.
 *     $Genlog             - creates or continues a changelog. This command
 *                           temporarily checks out the current archive (cvs co .) !
 *     $Config             - sets up the CVS service within TCP/IP configuration and
 *                           rewrites cvsservice.cmd and archives.lst
 *     $Pause              - pause NOSAADM CVS service
 *     $Resume             - resume NOSAADM CVS service
 */
/* First comment is used as help text */
/* CHECKVER */
/* ***** BEGIN LICENSE BLOCK *****
* Version: CDDL 1.0
*
* The contents of this file are subject to the COMMON DEVELOPMENT AND
* DISTRIBUTION LICENSE (CDDL) Version 1.0 (the "License"); you may not use
* this file except in compliance with the License. You may obtain a copy of
* the License at http://www.sun.com/cddl/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is
* "netlabs.org Open Source Archive Administrator/Client"
*
* The Original Distribution Package is named
* "netlabs.org Open Source Archive Administrator/Client"
* and maintained and distributed by the Initial Developer
* and/or netlabs.org only.
*
* In addition to the CDDL the following applies:
* If you modify the Original Code, you may distribute it only
* as a part of a distribution package where
*  - the name of the package, created directories or
*    OS2.INI entries do not contain any of the terms
*    - "netlabs.org Open Source Archive"
*    - "NOSA"
*    - "NOSAC"
*    - "NOSAADM"
*  - neither netlabs.org nor the Initial Developer is stated as
*    the vendor or originator of the resulting Distribution Package,
*    which contains the Modified Code.
*
* The Initial Developer of the Original Code is
* netlabs.org: Christian Langanke <cla@clanganke.de>.
* Portions created by the Initial Developer are Copyright (C) 1999-2008
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** */

 SIGNAL ON HALT

 TitleLine = STRIP(SUBSTR(SourceLine(2), 3));
 PARSE VAR TitleLine CmdName'.CMD 'Info
 Title     = CmdName Info

 env          = 'OS2ENVIRONMENT';
 TRUE         = (1 = 1);
 FALSE        = (0 = 1);
 Redirection  = '> NUL 2>&1';
 CrLf         = "0d0a"x;
 '@ECHO OFF'

 /* OS/2 errorcodes */
 ERROR.NO_ERROR           =  0;
 ERROR.INVALID_FUNCTION   =  1;
 ERROR.FILE_NOT_FOUND     =  2;
 ERROR.PATH_NOT_FOUND     =  3;
 ERROR.ACCESS_DENIED      =  5;
 ERROR.NOT_ENOUGH_MEMORY  =  8;
 ERROR.INVALID_FORMAT     = 11;
 ERROR.INVALID_DATA       = 13;
 ERROR.NO_MORE_FILES      = 18;
 ERROR.WRITE_FAULT        = 29;
 ERROR.READ_FAULT         = 30;
 ERROR.GEN_FAILURE        = 31;
 ERROR.INVALID_PARAMETER  = 87;
 ERROR.ENVVAR_NOT_FOUND   = 203;

 GlobalVars = 'Title CmdName env TRUE FALSE Redirection ERROR.';
 SAY;

 /* load RexxUtil */
 CALL RxFuncAdd    'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs';
 CALL SysLoadFuncs;

 /* Defaults */
 GlobalVars = GlobalVars 'CallDir UnzipExclude BinFileTypes CvsKeyword CvsBranches',
                         'ArchiveCommentFile IniAppName IniAppName_Comment StopFile',
                         'ConfigDir ServiceProgram ArchiveList PrivateList ErrorMsg GuestAccount';

 CallDir    = GetCallDir();
 CurrentDir = DIRECTORY();

 ArchiveCommentFile = 'archivecomment';
 ArchiveComment     = '';
 ProjectInfoFile    = 'CVSROOT\projectinfo';

 StopFile           = CallDir'\.cvsstop';
 ConfigDir          = CallDir'\config';
 ServiceProgram     = ConfigDir'\cvsservice.cmd';
 ArchiveList        = ConfigDir'\archives.lst';
 PrivateList        = ConfigDir'\private.lst';

 BinFileTypes = '.BMP .GIF .JPG .ICO .ZIP .PTR .CUR .ANI .AND .PCX .TGA .TIF';
 UnzipExclude = '*.obj *.exe *.map *.msg *.res */CVS/*';

 IniAppName         = 'NOSAADM';
 IniAppName_Comment = 'NOSAADM_COMMENTS';

 ArchiveVarname     = 'NOSAADM_ARCHIVE';

 GuestAccount = 'guest readonly';

 SwitchChars  = '$/-';

 rc = ERROR.NO_ERROR;

 TypeBinary       = TRUE;
 TypeAscii        = FALSE;

 fInitArchive     = FALSE;
 fImportArchive   = FALSE;
 fSecureArchive   = FALSE;
 fCreateSnapshot  = FALSE;
 fCreateBackup    = FALSE;
 fGenerateLog     = FALSE;
 fMakePrivate     = FALSE;
 fMakePublic      = FALSE;
 ErrorMsg         = '';

 fArchiveDirExists = FALSE;

 CvsKeyword       = 'Id';
 CvsBranches      = '';

 /* show help */
 ARG Parm .
 IF ((Parm = '') | (POS('?', Parm) > 0)) THEN
 DO
    rc = ShowHelp();
    EXIT(ERROR.INVALID_PARAMETER);
 END;


 DO UNTIL (TRUE)

    /* -------------------------------------------------------------- */

    /* initialise */
    BinFileTypes = TRANSLATE( BinFileTypes); /* nur zur Sicherheit */

    /* read some vars from ini */
    CvsHostname     = ReadIniValue(, IniAppName, 'CVS_HOSTNAME');
    CvsArchiveRoot  = ReadIniValue(, IniAppName, 'CVS_ARCHIVEROOT');
    CvsWorkRoot     = ReadIniValue(, IniAppName, 'CVS_WORKROOT');
    CvsSnapshotRoot = ReadIniValue(, IniAppName, 'CVS_SNAPSHOTROOT');
    CvsBackupRoot   = ReadIniValue(, IniAppName, 'CVS_BACKUPROOT');
    CvsInitCommand  = ReadIniValue(, IniAppName, 'CVS_INITCOMMAND');
    CvsHome         = ReadIniValue(, IniAppName, 'CVS_HOME');
    CvsExe          = ReadIniValue(, IniAppName, 'CVS_EXE');
    CvsUser         = ReadIniValue(, IniAppName, 'CVS_USER');

    MissingVar = '';
    SELECT
       WHEN (CvsHostname     = '') THEN MissingVar = 'hostname for this server';
       WHEN (CvsArchiveRoot  = '') THEN MissingVar = 'root directory for archive directories';
       WHEN (CvsWorkRoot     = '') THEN MissingVar = 'root directory for working directories';
       WHEN (CvsSnapshotRoot = '') THEN MissingVar = 'root directory for snapshot directories';
       WHEN (CvsBackupRoot   = '') THEN MissingVar = 'root directory for backup directories';
       WHEN (CvsHome         = '') THEN MissingVar = 'homedirectory';
       WHEN (CvsUser         = '') THEN MissingVar = 'user id';
       OTHERWISE NOP;
    END;

    IF (MissingVar \= '') THEN
    DO
       ErrorMsg = 'The' MissingVar 'is not defined.' CRLF||,
                  'Run INSTALL.CMD first.';
       rc = ERROR.ENVVAR_NOT_FOUND
       LEAVE;
    END;

    /* is a precommand given ? */
    IF (CvsInitCommand \= '') THEN
       'CALL' CvsInitCommand;

    /* make CVS binaries available */
    rc = SetCVSPath( CvsExe);
    IF (rc \= ERROR.NO_ERROR) THEN
       LEAVE;

    /* search unzip */
    fUnzipFound = (SysSearchPath('PATH', 'UNZIP.EXE') \= '');

    IF (\fUnzipFound) THEN
    DO
       ErrorMsg = 'unzip.exe could not be found!';
       rc = ERROR.FILE_NOT_FOUND;
       LEAVE;
    END;

    /* -------------------------------------------------------------- */

    /* check parms */
    ArchiveVar = VALUE( ArchiveVarname, '', env);
    PARSE ARG Archive Command Option;
    Archive = STRIP( Archive);

    SELECT
       WHEN (POS( LEFT(Archive, 1), SwitchChars) > 0) THEN
       DO
          PARSE ARG  Command Option;
          Archive = STRIP( ArchiveVar);
       END;

       OTHERWISE
    END;

    OptionValue = Option;
    Option      = STRIP(TRANSLATE( Option));
    Command      = STRIP(TRANSLATE( Command));

    /* strip off switch character */
    Command = SUBSTR( Command, 2);

    /* - set ARCHIVE */
    rcx = VALUE( ArchiveVarname, Archive, env);

    /* - do some prechecks */
    fArchiveDirExists = DirExist( CvsArchiveRoot'\'Archive'\CVSROOT');
    fBackupOk = ((fArchiveDirExists) | (Archive = '*'));

    SELECT

       WHEN (Command = '') THEN
       DO
/*
          ErrorMsg = 'Invalid action specified';
          rc = ERROR.INVALID_PARAMETER;
*/
       END;


       WHEN (POS(Command, 'WORK') = 1) THEN
          Command = '';

       WHEN (POS(Command, 'PAUSE') = 1) THEN
          EXIT( SetCvsService( 'PAUSE', StopFile));

       WHEN (POS(Command, 'RESUME') = 1) THEN
          EXIT( SetCvsService( 'RESUME', StopFile));

       WHEN (POS(Command, 'BIN') = 1) THEN
       DO
          rcx = DIRECTORY( Calldir);
          rc = ERROR.NO_ERROR;
          LEAVE;
       END;

       WHEN (POS(Command, 'EDIT') = 1) THEN
       DO
          rc = ERROR.NO_ERROR;
          OptionValue = TRANSLATE( OptionValue);
          SELECT
             WHEN (POS( OptionValue, 'RC')          = 1) THEN EditFile = CvsHome'\.cvsrc';
             WHEN (POS( OptionValue, 'SERVICE')     = 1) THEN EditFile = ServiceProgram;
             WHEN (POS( OptionValue, 'INET')        = 1) THEN EditFile = '%ETC%\inetd.lst';
             WHEN (POS( OptionValue, 'ARCHIVELIST') = 1) THEN EditFile = ArchiveList;
             WHEN (POS( OptionValue, 'PRIVATELIST') = 1) THEN EditFile = PrivateList;

             OTHERWISE
             DO
                EditFile = '';
                ErrorMsg = 'invalid edit type specified. Valid are:'CrLf,
                           '  Rc          - CVS resource file'CrLf,
                           '  Service     - CVS service script uset by INETD'CrLf,
                           '  Inet        - current INETD list'CrLf,
                           '  Archivelist - current public archive list'CrLf,
                           '  Privatelist - current private archive list'CrLf;
                rc = ERROR.INVALID_PARAMETER;
             END;
          END;

          IF (EditFile \= '') THEN
             'CALL TEDIT' EditFile;

          LEAVE;
       END;

       WHEN (POS(Command, 'CONFIG') = 1) THEN
       DO
          ErrorMsg = 'The CVS service could not be setup.';
          rc = SetupCVSService( CvsArchiveRoot, CvsExe, CvsHostName, CvsHome);
          RETURN(rc);
       END;

       WHEN (POS(Command, 'LIST') = 1) THEN
       DO
          rc = ListArchives( CvsArchiveRoot);
          LEAVE;
       END;

       WHEN ((Archive = '') | (POS(LEFT(Archive, 1), SwitchChars) > 0 )) THEN
       DO
          ErrorMsg = 'No archive name specified.';
          rc = ERROR.INVALID_PARAMETER;
       END;

       WHEN (POS(Command, 'ARCHIVE') = 1) THEN
       DO
          rcx = DIRECTORY( CvsArchiveRoot'\'Archive);
          rc = ERROR.NO_ERROR;
          LEAVE;
       END;

       WHEN (POS(Command, 'INIT') = 1) THEN
       DO
          IF (FileExist( CvsArchiveRoot'\'Archive'\CVSROOT\*')) THEN
             SAY 'Warning: working directory for archive' Archive 'already exists';
          ELSE
             fInitArchive = TRUE;
       END;

       WHEN (POS(Command, 'PRIVATE') = 1) THEN
             fMakePrivate = TRUE;

       WHEN (POS(Command, 'PUBLIC') = 1) THEN
             fMakePublic = TRUE;

       /* archive exists ? */
       WHEN ((POS(Command, 'BACKUP') = 1) & (fBackupOk)) THEN
          fCreateBackup = TRUE;

       /* all other options require an existing archive */
       WHEN (\fArchiveDirExists) THEN
       DO
          SAY 'error: archive directory for archive' Archive 'does not exist.';
          rc = ERROR.PATH_NOT_FOUND;
          RETURN( rc);
       END;

       WHEN (POS(Command, 'SECURE') = 1) THEN
          fSecureArchive = TRUE;

       WHEN (POS(Command, 'GENLOG') = 1) THEN
          fGenerateLog = TRUE;

       /* place COMMENT after CONFIG ! */
       WHEN (POS(Command, 'COMMENT') = 1) THEN
       DO
          ErrorMsg = 'The comment for archive' Archive 'could not be set.';
          IF (OptionValue = '') THEN
             rc = EditArchiveComment( Archive, CvsArchiveRoot, GetArchiveComment( Archive, CvsArchiveRoot));

          ELSE
             rc = SetArchiveComment( Archive, CvsArchiveRoot, OptionValue);
          LEAVE;
       END;

       /* place CLEARWORK after CONFIG ! */
       WHEN (POS(Command, 'CLEARWORK') = 1) THEN
       DO
          ErrorMsg = '';
          rc = CheckForUncommittedFiles( CvsWorkRoot'\'Archive);
          IF (rc \= ERROR.NO_ERROR) THEN
          DO
             SAY '  Working directory tree contains uncommitted changes !';
             IF (\ProceedWithEnter( '  Do you want to continue anyway')) THEN
                LEAVE;
          END;

          ErrorMsg = 'The working directory for' Archive 'could not be cleared.';
          rc = ClearDirectory( CvsWorkRoot'\'Archive);
          LEAVE;
       END;

       WHEN (POS(Command, 'DELETE') = 1) THEN
       DO
          rc = ClearArchiveDirectories( Archive, TRUE);
          LEAVE;
       END;

       /* place SNAPSHOT after SECURE ! */
       WHEN (POS(Command, 'SNAPSHOT') = 1) THEN
       DO
          fCreateSnapshot = TRUE;
          RevisionName    = Option;
       END;

       WHEN (POS(Command, 'REINIT') = 1) THEN
       DO

          /* save current archive comment for reinit */
          ArchiveComment = GetArchiveComment( Archive, CvsArchiveRoot);

          /* delete all directories */
          rc = ClearArchiveDirectories( Archive, FALSE);
          IF (rc != ERROR.NO_ERROR) THEN
             LEAVE;
          fInitArchive = TRUE;
       END;

       /* place IMPORT after INIT ! */
       WHEN (POS(Command, 'IMPORT') = 1) THEN
       DO
          DO UNTIL (TRUE)

             ImportName = OptionValue;

             /* zip file is required */
             IF (ImportName = '') THEN
             DO
                ErrorMsg = 'No zip file or directory specified for import.';
                rc = ERROR.FILE_NOT_FOUND;
                LEAVE;
             END;
             IF (\FileExist( ImportName)) THEN
             DO
                ErrorMsg = 'zip file or directory' ImportName 'could not be found.';
                rc = ERROR.PATH_NOT_FOUND;
                LEAVE;
             END;

             fImportArchive = TRUE;

             /* working dir must be empty !. Easy way */
             /* to ensure all data is committed       */
             rc = SysFileTree( CvsWorkRoot'\'Archive'\*', 'File.', 'FOS');
             IF ((rc \= 0) | (File.0 > 0)) THEN
             DO
                ErrorMsg = 'The working directory' Archive 'is not empty.';
                rc = ERROR.ACCESS_DENIED;
             END;    ;

          END;

       END; /* WHEN */

       WHEN (Command \= '') THEN
       DO
          ErrorMsg = 'invalid option specified.';
          rc = ERROR.INVALID_PARAMETER;
       END;

       WHEN (\FileExist( CvsArchiveRoot'\'Archive'\CVSROOT\*')) THEN
       DO
          ErrorMsg = 'The working directory' Archive 'could not be found.';
          rc = ERROR.PATH_NOT_FOUND;
       END;

       OTHERWISE NOP;

    END;

    IF (rc \= ERROR.NO_ERROR) THEN
       LEAVE;

    /* ################################################################################### */


    /* create backup zip */
    IF (fCreateBackup) THEN
    DO
       ErrorMsg = 'The backup for' Archive 'could not be created.';
       rc = CreateBackups( Archive, CvsBackupRoot, CvsArchiveRoot, Timestamp);
       LEAVE;
    END;

    /* .............................................................. */

    /* set up environment */
    CALL CHAROUT, 'Initialize environment for archive' Archive '... ';

    /* extend path to this directory, making cvsenv available */
    AddToPath = CallDir';'CallDir'\bin;';
    CurrentPath = VALUE( 'PATH',,env);
    IF (POS( AddToPath, CurrentPath) = 0) THEN
    DO
       /* - extend PATH */
       rcx = VALUE('PATH', AddToPath''CurrentPath,env);

       /* - extend LIBPATH */
       'SET BEGINLIBPATH='AddToPath'%BEGINLIBPATH%';
    END;

    /* - set USER */
    rcx = VALUE( 'USER', CvsUser, env);

    /* - set homedirectory */
    rcx = VALUE('HOME', dosslash(CvsHome), env);

    /* - set CVSROOT */
    rcx = VALUE( 'CVSROOT', ':local:'CvsArchiveRoot'\'Archive, env);
    SAY 'Ok.';

    /* .............................................................. */

    /* generate log  - requires initialization ! */
    IF (fGenerateLog) THEN
    DO
       /* update local directory first */
       CALL CHAROUT, 'Checking out/updating current archive contents ... ';
       'CALL cvs co .' Redirection;
       IF (rc = ERROR.NO_ERROR) THEN
       DO
          SAY 'Ok.';

          /* call external routine */
          rc = cvsgenlog( Option);
       END;
       ELSE
          SAY 'Error !';

       rc = ERROR.NO_ERROR;
       LEAVE;
    END;

    /* .............................................................. */

    /* create snapshot zip */
    IF (fCreateSnapshot) THEN
    DO
       ErrorMsg = 'The snapshot for' Archive 'could not be created.';
       rc = CreateSnapshot( Archive, CvsSnapshotRoot, RevisionName);
       LEAVE;
    END;

    /* .............................................................. */

    /* secure archive */
    IF (fSecureArchive) THEN
    DO
       ErrorMsg = 'The archive' Archive 'could not be created.';
       rc = SecureArchive( Archive, CvsArchiveRoot, CvsWorkRoot, CvsUser);
       LEAVE;
    END; /* IF (fSecureArchive) THEN */

    /* .............................................................. */

    /* initialise new archive */
    IF (fInitArchive) THEN
    DO
       /* is archive comment being specified as parameter ? */
       IF (OptionValue = '') THEN
          /* prompt for archive comment */
          ArchiveComment = STRIP(PullVariable( ArchiveComment, 'Enter the comment for this archive:'));
       ELSE
          ArchiveComment = OptionValue;

       ErrorMsg = 'The archive' Archive 'could not be initialized.';
       rc = InitializeArchive( Archive, CvsArchiveRoot, CvsWorkRoot, ArchiveComment);
       LEAVE;
    END;


    /* change to local working dir for archive */
    IF (CvsWorkRoot \= '') THEN
       rcx = DIRECTORY( CvsWorkRoot'\'Archive);

    /* .............................................................. */

    /* import zip archive file */
    IF (fImportArchive) THEN
    DO
       ErrorMsg = 'The import could not be completed.';
       rc = ImportArchive( Archive, ImportName, CvsArchiveRoot, CvsWorkRoot);
       LEAVE;

    END; /* IF (fImportArchive) THEN */

    /* .............................................................. */

    /* make archive private - requires initialization ! */
    IF (fMakePrivate) THEN
    DO
       ErrorMsg = 'The archive could not be turned to private.';
       rc = MakeArchivePrivate( Archive, CvsArchiveRoot, CvsUser);
       LEAVE;

    END; /* IF (fMakePrivate) THEN */

    /* .............................................................. */

    /* make archive public - requires initialization ! */
    IF (fMakePublic) THEN
    DO
       ErrorMsg = 'The archive could not be turned to public.';
       rc = MakeArchivePublic( Archive, CvsArchiveRoot, CvsUser);
       LEAVE;

    END; /* IF (fMakePrivate) THEN */

 END;

 /* exit */
 IF ((rc \= ERROR.NO_ERROR) & (ErrorMsg \= '')) THEN
 DO
    SAY;
    SAY CmdName': Error:' ErrorMsg;
    'PAUSE'
 END;
 EXIT( rc);


/* ------------------------------------------------------------------------- */
HALT:
 SAY;
 SAY 'Interrupted by user.';
 EXIT(ERROR.GEN_FAILURE);

/* ------------------------------------------------------------------------- */
ShowHelp: PROCEDURE EXPOSE (GlobalVars)

 SAY Title;
 SAY;

 PARSE SOURCE . . ThisFile

 DO i = 1 TO 3
    rc = LINEIN(ThisFile);
 END;

 ThisLine = LINEIN(Thisfile);
 DO WHILE (ThisLine \= ' */')
    SAY SUBSTR(ThisLine, 7);
    ThisLine = LINEIN(Thisfile);
 END;

 rc = LINEOUT(Thisfile);

 RETURN('');

/* ------------------------------------------------------------------------- */
FileExist: PROCEDURE
 PARSE ARG FileName

 RETURN(STREAM(Filename, 'C', 'QUERY EXISTS') > '');

/* ------------------------------------------------------------------------- */
LOWER: PROCEDURE

 Lower = 'abcdefghijklmnopqrstuvwxyz„”';
 Upper = 'ABCDEFGHIJKLMNOPQRSTUVWXYZŽ™š';

 PARSE ARG String
 RETURN(TRANSLATE(String, Lower, Upper));

/* -------------------------------------------------------------------------- */
GetDirName: PROCEDURE
 PARSE ARG Name

 /* save environment */
 CurrentDrive = FILESPEC('D', DIRECTORY());
 CurrentDir   = DIRECTORY(FILESPEC('D', Name));

 /* try directory */
 DirFound  = DIRECTORY(Name);

 /* reset environment */
 rc = DIRECTORY(CurrentDir);
 rc = DIRECTORY(CurrentDrive);

 RETURN( DirFound);

/* ========================================================================= */
ProceedWithEnter: PROCEDURE
 PARSE ARG Prompt

 ResponseKeys  = 'Y N A R I'; /* SysGetMessage(0); */
 Yes           = WORD(ResponseKeys, 1);
 No            = WORD(ResponseKeys, 2);
 ch            = ' ';
 ValidResponse = Yes||No;

 SAY;
 SAY Prompt '(press 'Yes'/'No' and <Enter>) '
 DO WHILE (POS(ch, ValidResponse) = 0)
    ch = LINEIN();
    ch = TRANSLATE(LEFT(ch, 1));
    IF (POS(ch, ValidResponse) = 0) THEN BEEP(800, 200);
 END;
 SAY;
 SAY;
 RETURN(ch = Yes);

/* ========================================================================= */
ReadIniValue: PROCEDURE
PARSE ARG IniFile, IniAppname, IniKeyName

 IniValue = SysIni(IniFile, IniAppname, IniKeyName);
 IF (IniValue = 'ERROR:') THEN
    IniValue = '';

 IF ((IniValue \= '') & (RIGHT(IniValue, 1) = "00"x)) THEN
    IniValue = LEFT( IniValue, LENGTH( IniValue) - 1);

 RETURN( IniValue);

/* ========================================================================= */
CreateArchiveDir: PROCEDURE EXPOSE (GlobalVars)
 PARSE ARG Pathname, Title

 CALL CHAROUT, '- Creating' Title ' ... ';
 rc = SysMkDir( PathName);
 IF (rc = ERROR.NO_ERROR) THEN
    SAY 'Ok.';
 ELSE
    SAY 'Error!';
 RETURN(rc);

/* ------------------------------------------------------------------------- */
GetCalldir: PROCEDURE
PARSE SOURCE . . CallName
 CallDir = FILESPEC('Drive', CallName)||FILESPEC('Path', CallName);
 RETURN(LEFT(CallDir, LENGTH(CallDir) - 1));

/* ------------------------------------------------------------------------- */
PullVariable: PROCEDURE
 PARSE ARG Default, Message

 SAY;
 CALL CHAROUT, Message '['Default'] : ';
 PARSE PULL PullVar;
 IF (LENGTH(PullVar) > 0) THEN
    RETURN(PullVar);
 ELSE
    RETURN(Default);

 /* ------------------------------------------------------------------------- */
DirExist: PROCEDURE
 PARSE ARG Dirname

 IF (Dirname = '') THEN
    RETURN(0);

 /* use 'QUERY EXISTS' with root dirs */
 IF (RIGHT(DirName, 2) = ':\') THEN
   RETURN(STREAM(Dirname, 'C', 'QUERY EXISTS') \= '');

 /* query all others */
 IF ((STREAM(Dirname, 'C', 'QUERY EXISTS') = '') &,
     (STREAM(Dirname, 'C', 'QUERY DATETIME') \= '')) THEN
    RETURN(1);
 ELSE
    RETURN(0);

/* ------------------------------------------------------------------------- */
GetInstDrive: PROCEDURE EXPOSE env
 ARG DirName, EnvVarName

 /* Default: OS2-directory -> determines bootdrive */
 IF (DirName = '') THEN DirName = '\OS2';

 /* Default: PATH  */
 IF (EnvVarName = '') THEN EnvVarName = 'PATH';

 /* get value */
 PathValue = TRANSLATE(VALUE(EnvVarName,,env));

 /* search entry and return drive */
 DirName = ':'DirName';';
 EntryPos = POS(DirName, PathValue) - 1;
 IF (EntryPos = -1) THEN
    RETURN('');
 InstDrive = SUBSTR(PathValue, EntryPos, 2);
 RETURN(InstDrive);

/* ------------------------------------------------------------------------- */
MakePath: PROCEDURE EXPOSE (GlobalVars)
 PARSE ARG PathName;

 PARSE SOURCE . . CallName
 FileName = SUBSTR( CallName, LASTPOS( '\', CallName) + 1);
 'XCOPY' CallName PathName'\' Redirection;
 rcx = SysFileDelete( PathName'\'FileName);
 RETURN( rc);

/* ========================================================================= */
dosslash: PROCEDURE
 PARSE ARG string
 RETURN(TRANSLATE( string, '\', '/'));

/* ========================================================================= */
SetCVSPath: PROCEDURE EXPOSE (GlobalVars)
 PARSE ARG CvsExe;

 rc = ERROR.NO_ERROR;

 DO UNTIL (TRUE)

    /* - search CVS binaries in PATH; if found, use these */
    IF (SysSearchPath('PATH', 'CVS.EXE') \= '') THEN
       LEAVE;

    /* otherwise make sure that EXE found by install is present */
    IF (\FileExist( CvsExe)) THEN
    DO
       ErrorMsg = 'CVS binaries could not be found!';
       rc = ERROR.FILE_NOT_FOUND;
       LEAVE;
    END;

    /* - extend path to CVS binaries */
    AddToPath = LEFT( CvsExe, LASTPOS( '\', CvsExe) - 1)';';
    CurrentPath = VALUE( 'PATH',,env);
    IF (POS( AddToPath, CurrentPath) = 0) THEN
       rcx = VALUE('PATH', AddToPath''CurrentPath,env);
 END;

 RETURN( rc);

/* ========================================================================= */
unixslash: PROCEDURE
 PARSE ARG string
 RETURN(TRANSLATE( string, '/', '\'));

/* ========================================================================= */
FileContains: PROCEDURE
 PARSE ARG Text, File;

 rc = SysFileSearch( Text, File, 'FoundLine.');
 RETURN((rc = 0) & (FoundLine.0 > 0));

/* ========================================================================= */
ClearDirectory: PROCEDURE EXPOSE (GlobalVars);
 PARSE ARG DirName, fRemove;

 rc = ERROR.NO_ERROR;
 IF (fRemove = '') THEN
    fRemove = FALSE;

 DO UNTIL (TRUE)
    IF (\DirExist( DirName)) THEN
       RETURN( rc);

    IF (fRemove) THEN
       CALL CHAROUT, '- Deleting' DirName '... ';
    ELSE
       CALL CHAROUT, '- Deleting contents of' DirName '... ';

    /* delete files first */
    rc = SysFileTree( DirName'\*', 'File.', 'FOS');
    IF (rc \= ERROR.NO_ERROR) THEN
    DO
       rc = ERROR.NOT_ENOUGH_MEMORY;
       LEAVE;
    END;
    DO i = File.0 TO 1 BY -1
       rc = SysFileTree( File.i, 'ThisFile.', 'F', '*****','-----');
       rc = SysFileDelete( File.i);
       IF (rc \= ERROR.NO_ERROR) THEN
          LEAVE;
    END;
    IF (rc \= ERROR.NO_ERROR) THEN
       LEAVE;

    /* delete directories then */
    rc = SysFileTree( DirName'\*', 'Dir.', 'ODS');
    IF (rc \= ERROR.NO_ERROR) THEN
    DO
       rc = ERROR.NOT_ENOUGH_MEMORY;
       LEAVE;
    END;

    DO i = Dir.0 TO 1 BY -1
       'RD' Dir.i Redirection;
    END;

    /* search any remaining files and directories now */
    rc = SysFileTree( DirName'\*', 'Both.', 'OBS');
    IF (rc \= ERROR.NO_ERROR) THEN
    DO
       rc = ERROR.NOT_ENOUGH_MEMORY;
       LEAVE;
    END;
    IF (Both.0 > 0) THEN
    DO
       rc = ERROR.ACCESS_DENIED;
       LEAVE;
    END;

    /* shall complete directory be removed  ? */
    IF (fRemove) THEN
       rc = SysRmDir( DirName);

 END;

 IF (rc = ERROR.NO_ERROR) THEN
    SAY 'Ok.';
 ELSE
    SAY 'Error !';

 RETURN( rc);

/* ========================================================================= */
CheckForUncommittedFiles: PROCEDURE EXPOSE (GlobalVars);
 PARSE ARG DirName;

 rc = ERROR.NO_ERROR;
 IF (fRemove = '') THEN
    fRemove = FALSE;

 DO UNTIL (TRUE)
    IF (\DirExist( DirName)) THEN
       RETURN( rc);

    CALL CHAROUT, '- Checking' DirName '... ';
    'cvs status . 2>&1 | find "Status: Locally" > NUL';
    rc = \rc;

 END;

 IF (rc = ERROR.NO_ERROR) THEN
    SAY 'Ok.';
 ELSE
    SAY 'Error !';

 RETURN( rc);

/* ========================================================================= */
CheckMissingFile: PROCEDURE
 PARSE ARG Filename;

 IF (\FileExist( Filename)) THEN
    RETURN( FILESPEC( 'N', Filename));
 ELSE
    RETURN('');

/* ========================================================================= */
SetupCVSService: PROCEDURE EXPOSE (GlobalVars);
 PARSE ARG CvsArchiveRoot, CvsExe, Hostname, CvsHome;

 /* defaults */
 rc              = ERROR.NO_ERROR;
 fChanged        = FALSE;
 UnixArchiveRoot = SUBSTR( CvsArchiveRoot, POS( ':', CvsArchiveRoot) + 1);
 ArchiveCount    = 0;

 DO UNTIL (TRUE)

    /* get some values */
    EtcDir = VALUE( 'ETC',,env);
    IF (EtcDir = '') THEN
    DO
       SAY 'etc variable not set.';
       rc = ERROR.ENVVAR_NOT_FOUND;
       LEAVE;
    END;
    TmpDir = VALUE( 'TMP',,env);
    IF (TmpDir = '') THEN
    DO
       SAY 'tmp variable not set.';
       rc = ERROR.ENVVAR_NOT_FOUND;
       LEAVE;
    END;

    InetdListFile  = EtcDir'\inetd.lst';
    CvsRcFile      = CvsHome'\.cvsrc';
    ServicesFile   = EtcDir'\services';
    TcpStartFile   = SysSearchPath( 'PATH', 'tcpstart.cmd');

    /* rewrite service program */
    Filename = CvsArchiveRoot'\*';
    Options  = 'OD';
    rc = SysFileTree( FileName, 'ArchiveDir.', Options);
    IF (rc \= ERROR.NO_ERROR) THEN
    DO
       ErrorMsg = 'Error in SysFileTree: not enough memory.';
       rc = ERROR.NOT_ENOUGH_MEMORY;
       LEAVE;
    END;

    MaxNameLen = 0;
    DO i = 1 TO ArchiveDir.0
       IF (DirExist( ArchiveDir.i'\CVSROOT')) THEN
       DO
          PARSE VAR ArchiveDir.i .':'ArchiveDir.i;
          ArchiveDir.i = unixslash( ArchiveDir.i);
          MaxNameLen = MAX( MaxNameLen, LENGTH(ArchiveDir.i));
          ArchiveCount = ArchiveCount + 1;
       END;
       ELSE
          ArchiveDir.i = '';
    END;

    rcx = SysMkDir( ConfigDir);
    rcx = SysFileDelete( ServiceProgram);
    rcx = SysFileDelete( CvsRcFile);

    IF (ArchiveCount = 0) THEN
       SAY '- skipping creation of service program and resource file: no archives present.'
    ELSE
    DO
       /* write cvsservice.cmd with only one allow-root */
       /* the complete list is written to .cvsrc below */
       CALL CHAROUT, 'Writing service program ... ';
       TextLen = LENGTH( Title);
       rcx = LINEOUT( ServiceProgram, '@ECHO OFF');
       rcx = LINEOUT( ServiceProgram, ': cvsservice program generated at' DATE('E') TIME());
       rcx = LINEOUT( ServiceProgram, ':' Title);
       rcx = LINEOUT( ServiceProgram, '');
       rcx = LINEOUT( ServiceProgram, ': set environment and change to source drive');
       rcx = LINEOUT( ServiceProgram, '' FILESPEC('D', CvsArchiveRoot));
       rcx = LINEOUT( ServiceProgram, ' SET HOME='CvsHome);
       rcx = LINEOUT( ServiceProgram, '');
       rcx = LINEOUT( ServiceProgram, ' IF EXIST' StopFile 'SET STOPOPTION=-f');
       rcx = LINEOUT( ServiceProgram, ' CALL' CvsExe '%STOPOPTION% --allow-root='unixslash( UnixArchiveRoot)'/dummy pserver %1');
       rcx = STREAM( ServiceProgram, 'C', 'CLOSE');
       SAY 'Ok.';

       /* write all archives to .cvsrc, but without drive letter ! */
       CALL CHAROUT, 'Writing cvs resource file ... ';
       rcx = LINEOUT( CvsRcFile);
       rcx = LINEOUT( CvsRcFile, '# cvs server resource file generated at' DATE('E') TIME());
       rcx = LINEOUT( CvsRcFile, '#' Title);
       rcx = LINEOUT( CvsRcFile, '');
       CvsCommand = 'cvs';
       DO i = 1 TO ArchiveDir.0
          IF (ArchiveDir.i \= '') THEN
             CvsCommand = CvsCommand '--allow-root='ArchiveDir.i;
       END;
       rcx = LINEOUT( CvsRcFile, CvsCommand);
       rcx = STREAM( CvsRcFile, 'C', 'CLOSE');
       SAY 'Ok.';
    END;

    rcx = LINEOUT( CvsRcFile);

    /* write all archives to archive list file */
    /* take care for private archives though   */
    PrivateArchives = '';
    PublicArchives  = '';
    rcx = SysFileDelete( ArchiveList);
    rcx = SysFileDelete( PrivateList);
    IF (ArchiveCount = 0) THEN
       SAY '- skipping creation of archive list files: no archives present.'
    ELSE
    DO
       CALL CHAROUT, 'Writing archive list files ... ';
       RootMaxLen = LENGTH( Hostname)      + 1 +,
                    LENGTH(CvsArchiveRoot) + 1 +,
                    MaxNameLen             + 1;

       rcx = SysFileDelete( ArchiveList);
       DO i = 1 TO ArchiveDir.0
          IF (ArchiveDir.i = '') THEN ITERATE;

          ThisCvsRoot = Hostname':'ArchiveDir.i;
          SELECT
             WHEN (IsArchivePrivate( FILESPEC( 'N', ArchiveDir.i), CvsArchiveRoot)) THEN
             DO
                OutFile = PrivateList;
                PrivateArchives = PrivateArchives ArchiveDir.i;
             END;
             OTHERWISE
             DO
                OutFile = ArchiveList;
                PublicArchives = PublicArchives ArchiveDir.i;
             END;
          END;
          rcx = LINEOUT(OutFile, LEFT( ThisCvsRoot, RootMaxLen) GetArchiveComment( ArchiveDir.i, CvsArchiveRoot));
       END;
       rcx = STREAM( ArchiveList, 'C', 'CLOSE');
       rcx = STREAM( PrivateList, 'C', 'CLOSE');
       SAY 'Ok.';

       /* show what is there */
       PublicArchives  = STRIP( PublicArchives);
       PrivateArchives = STRIP( PrivateArchives);
       IF (PublicArchives = '')  THEN PublicArchives  = '-none-';
       IF (PrivateArchives = '') THEN PrivateArchives = '-none-';
       SAY '- public archives:' PublicArchives;
       SAY '- private archives:' PrivateArchives;
    END;

    /* all files present ? inetd.lst may not exist */
    CALL CHAROUT, 'Reading TCP/IP configuration ... ';
    MissingFiles =              CheckMissingFile( ServicesFile);
    MissingFiles = MissingFiles CheckMissingFile( TcpStartFile);
    IF (MissingFiles \= '') THEN
    DO
       SAY 'Error !';
       SAY;
       SAY 'The following file(s) of the TCP/IP configuration are missing:';
       SAY '   ' MissingFiles;
       SAY;
       rc = ERROR.FILE_NOT_FOUND;
       LEAVE;
    END;

    SAY 'Ok.';

    /* - services */
    CvsServiceName = 'cvspserver';
    fAddService    = TRUE;

    rc = SysFileSearch( CvsServiceName, ServicesFile, 'FoundLine.');
    IF (FoundLine.0 > 0) THEN
    DO
       DO i = 1 TO FoundLine.0
          PARSE VAR FoundLine.i ServiceName .;
          IF (LEFT( ServiceName, 1) = '#') THEN
             ITERATE;
          IF (ServiceName = CvsServiceName) THEN
          DO
             SAY '- skipping addition of CVS port to services: already included ('CvsServiceName')';
             fAddService    = FALSE;
             LEAVE;
          END;
       END;
    END;

    IF (fAddService) THEN
    DO
       CALL CHAROUT, '- adding CVS port ('CvsServiceName') to services ... ';
       rc = SysFileTree( ServicesFile, 'File.', 'FO',,'-----');
       rc = LINEOUT( ServicesFile, '# For CVS service ');
       rc = LINEOUT( ServicesFile, CvsServiceName '     2401/tcp');
       rc = LINEOUT( ServicesFile);
       SAY 'Ok.';
    END;

    /* - inetd.lst */
    IF ((FileExist(InetdListFile)) &  (FileContains( CvsServiceName, InetdListFile))) THEN
    DO
       SAY '- skipping addition of CVS service to inet daemon list: already included.';
    END;
    ELSE
    DO
       CALL CHAROUT, '- adding CVS service to inet daemon list ... ';
       rc = SysFileTree( InetdListFile, 'File.', 'FO',,'-----');
       rc = LINEOUT( InetdListFile, CvsServiceName 'tcp' ServiceProgram);
       rc = LINEOUT( InetdListFile);
       SAY 'Ok.';
       fChanged = TRUE;
    END;

    /* - tcpstart.cmd */
    fAutostarted = FALSE;
    InetdLine = 0;
    rc = SysFileSearch( ' inetd', TcpStartFile, 'FoundLine.', 'N');
    IF (FoundLine.0 > 0) THEN
    DO
       DO i = 1 TO FoundLine.0
          LastWord = TRANSLATE( WORD( FoundLine.i, WORDS( FoundLine.i)));
          IF ( LastWord = 'INETD') THEN
          DO
             InetdLine = WORD( FoundLine.i, 1);
             FirstWord = TRANSLATE( WORD( FoundLine.i, 2)); /* number at begin ! */
             IF (WORDPOS( FirstWord, 'REM DETACH :') = 0) THEN
             DO
                fAutostarted = TRUE;
                LEAVE;
             END;
          END;
       END;
    END;
    IF (fAutostarted) THEN
       SAY '- skipping to set internet super daemon to autostart: already autostarted.';
    ELSE
    DO
       CALL CHAROUT, '- set internet super daemon to autostart ... ';

       /* read lines and remove the appropriate REMs */
       TcpStartFileTmp = SysTempFileName( TmpDir'\tcpstart.???');
       LineCount = 1;
       DO WHILE (LINES(TcpStartFile) > 0)
          ThisLine = LINEIN( TcpStartFile);
          IF ((LineCount = InetdLine) | (LineCount = InetdLine + 1)) THEN
          DO

             FirstWord = TRANSLATE( WORD( ThisLine, 1));
             IF (WORDPOS( FirstWord, 'REM DETACH :') > 0) THEN
             DO
                /* remove remark */
                IF (FirstWord \= 'DETACH') THEN
                   ThisLine = DELWORD( ThisLine, 1, 1);

                /* check for start command: add /min parm */
                FirstWord = TRANSLATE( WORD( ThisLine, 1));
                fMinimized = (POS( '/MIN', TRANSLATE(ThisLine)) > 0);
                SELECT
                   WHEN ((FirstWord = 'START') & (\fMinimized)) THEN
                      ThisLine = INSERT( '/min ', ThisLine, WORDINDEX( ThisLine, 2) - 1);

                   WHEN (FirstWord = 'DETACH') THEN
                   DO
                      ThisLine = 'start /min' DELWORD( ThisLine, 1, 1);
                   END;

                   OTHERWISE NOP;
                END;

             /* reduce spaces */
             ThisLine = SPACE(ThisLine);

             END;
          END;
          rcx   = LINEOUT( TcpStartFileTmp, ThisLine);
          LineCount = LineCount + 1;
       END;
       rc = STREAM( TcpStartFile, 'C', 'CLOSE');
       rc = STREAM( TcpStartFileTmp, 'C', 'CLOSE');

       /* copy the new file onto the original */
       rc = SysFileTree( TcpStartFile, 'File.', 'FO',,'-----');
       'COPY' TcpStartFileTmp TcpStartFile Redirection;
       rc = SysFileDelete( TcpStartFileTmp);
       SAY 'Ok.';

       fChanged = TRUE;
    END;
 END;

 IF (fChanged) THEN
 DO
    SAY ;
    SAY 'The TCP/IP configuration has been changed';
    SAY 'In order to (re)activate the CVS service'
    SAY 'please stop the inetd session (if running)'
    SAY 'and execute the following command:';
    SAY '   tcpstart';
 END;

 SAY;
 RETURN( rc);

/* ========================================================================= */
CreateSnapshot: PROCEDURE EXPOSE (GlobalVars);
 PARSE ARG Archive, CvsSnapshotRoot, RevisionName;

 /* defaults */
 rc = SETLOCAL();
 fChanged = FALSE;
 rc = ERROR.NO_ERROR;
 CurrentDir = DIRECTORY();

 DO UNTIL (TRUE)


    /* get some values */
    TmpDir = VALUE( 'TMP',,env);
    IF (TmpDir = '') THEN
    DO
       SAY 'tmp variable not set.';
       rc = ERROR.ENVVAR_NOT_FOUND;
    END;

    /* create temp dir */
    CvsTmpDir = SysTempFileName( TmpDir'\snapshot.???');
    'MD' CvsTmpDir Redirection;
    IF (rc \= ERROR.NO_ERROR) THEN
    DO
       SAY 'Cannot create temporary directory.';
       LEAVE;
    END;

    /* change to it */
    rcx = DIRECTORY( CvsTmpDir);

    /* setup snapshot directory */
    'MD' CvsSnapshotRoot'\'Archive Redirection;
    LogFile = CvsSnapshotRoot'\'Archive'\'Archive'_'DATE('S')'.log';
    ZipName = CvsSnapshotRoot'\'Archive'\'Archive'_'DATE('S')'.zip';
    IF (FileExist( LogFile)) THEN rc = SysFileDelete( LogFile);
    IF (FileExist( ZipName)) THEN rc = SysFileDelete( ZipName);

    CALL CHAROUT, 'Checking out to temporary directory ...';
    IF (RevisionName = '') THEN
       'cvs co . >' LogFile '2>&1';
    ELSE
       'cvs co -r' RevisionName '. >' LogFile '2>&1';

    IF (rc \= ERROR.NO_ERROR) THEN
    DO
       SAY 'Error !';
       SAY 'See' LogName 'for details';
       LEAVE;
    END;
    ELSE
       SAY 'Ok.';

    /* creating zip file  */
    CALL CHAROUT, 'Creating zip file' ZipName '... ';
    'SET ZIP=';
    'zip -m -r -D' ZipName '* -x checkout.log >>' LogFile '2>&1';
    IF (rc \= ERROR.NO_ERROR) THEN
    DO
       SAY ' Error !';
       SAY 'See' LogName 'for details';
    END;
    ELSE
       SAY ' Ok.';

    /* reset directory and remove tmp dir */
    rcx = rc;
    rc = DIRECTORY( '..');
    'RD' CvsTmpDir Redirection;
    rc = rcx;

    rcx = DIRECTORY( CurrentDir);

 END;

 /* cleanup */
 rcx = DIRECTORY( CurrentDir);
 RETURN( rc);

/* ========================================================================= */
CreateBackups: PROCEDURE EXPOSE (GlobalVars);
 PARSE ARG Archive, CvsBackupRoot, CvsArchiveRoot;

 rc = ERROR.NO_ERROR;

 /* wildcards being used ? */
 IF (Archive = '*') THEN
    Archives = GetExportedArchives();
 ELSE
    Archives = Archive;

 ThisDate = DATE('S');
 ThisTime = TIME();
 SAY 'Creating backups at' ThisDate ThisTime 'for:'
 SAY Archives;
 SAY;
 Timestamp = ThisDate''TRANSLATE('abcdef', ThisTime, 'ab:cd:ef');
 DO WHILE (Archives \= '')
    PARSE VAR Archives Archive Archives;
    rc = CreateArchiveBackup( Archive, CvsBackupRoot, CvsArchiveRoot, TimeStamp);
 END;

 RETURN( rc);

/* ========================================================================= */
CreateArchiveBackup: PROCEDURE EXPOSE (GlobalVars);
 PARSE ARG Archive, CvsBackupRoot, CvsArchiveRoot, TimeStamp;

 /* defaults */
 rcx = SETLOCAL();
 fChanged = FALSE;
 CurrentDir = DIRECTORY();

 DO UNTIL (TRUE)

    /* setup snapshot directory */
    'MD' CvsBackupRoot'\'Archive Redirection;
    BackupDir = CvsBackupRoot'\'Archive;
    ZipName = BackupDir'\'TimeStamp'.zip';
    IF (FileExist( ZipName)) THEN rc = SysFileDelete( ZipName);

    /* creating zip file  */
    CALL CHAROUT, Archive': ';
    'SET ZIP=';
    'zip -r' ZipName CvsArchiveRoot'\'Archive'\*' Redirection;
    IF (rc \= ERROR.NO_ERROR) THEN
    DO
       SAY 'Error creating zip file' ZipName '!!!';
       LEAVE;
    END;
    ELSE
       CALL CHAROUT, STREAM( ZipName, 'C', 'QUERY SIZE') 'bytes ';

    /* check backup directory for this archive */
    rcx = SysFileTree( BackupDir'\*.zip', 'File.', 'F');
    TotalSize = 0;
    DO i = 1 TO File.0
       PARSE VAR File.i . . ThisSize .;
       TotalSize = TotalSize + ThisSize;
    END;

    SAY '-' TotalSize 'bytes in' File.0 'files'

 END;

 RETURN( rc);

/* ========================================================================= */
SecureArchive: PROCEDURE EXPOSE (GlobalVars);
 PARSE ARG Archive, CvsArchiveRoot, CvsWorkRoot, CvsUser;

 /* defaults */
 rc = SETLOCAL();
 fChanged = FALSE;
 rc = ERROR.NO_ERROR;
 CurrentDir = DIRECTORY();

 SAY;
 DO UNTIL (TRUE)

    /* is security prorgam available ? */
    CvsSecureScript = CallDir'\bin\cvssec.exe';
    IF (\FileExist(CvsSecureScript)) THEN
    DO
       ErrorMsg = 'Security program' CvsSecureScript 'not found.';
       rc = ERROR.FILE_NOT_FOUND;
       LEAVE;
    END;

    /* is archive initialized ? */
    CvsDbDir = CvsArchiveRoot'\'Archive'\CVSROOT';
    IF (\FileExist( CvsDbDir'\*')) THEN
    DO
       ErrorMsg = 'Archive not yet initialized.'
       rc = ERROR.INVALID_FUNCTION;
       LEAVE;
    END;

    PasswdFile = CallDir'\passwd';
    IF (\FileExist( PasswdFile)) THEN
    DO
       /* ask for password */
       SAY;

       DO WHILE (TRUE)
          CvsPassword1 = STRIP( PullVariable( ,            'Enter the password for' CvsUser));
          CvsPassword2 = STRIP( PullVariable( ,            'Enter the password for' CvsUser 'AGAIN'));

          IF (CvsUser = '') THEN
          DO
             SAY;
             SAY 'user not specified. Please try again.'
             ITERATE;
          END;

          IF (CvsPassword1 \= CvsPassword2) THEN
          DO
             SAY;
             SAY 'passwords are different. Please try again.'
             ITERATE;
          END;

          IF (CvsPassword1 = '') THEN
          DO
             SAY;
             SAY 'password not specified. Please try again.'
             ITERATE;
          END;

          SAY;
          LEAVE;
       END;

       /* distribute password file */
       CALL CHAROUT, '- Creating new passwd file ...';
       'CALL NOSAPW -add' GuestAccount Redirection;
       'CALL NOSAPW -add' CvsUser CvsPassword1 Redirection;
       SAY ' Ok.';
    END;

    /* copy the passwd file to the new archive directory */
    CALL CHAROUT, '- Copying current passwd file to archive CVSROOT ...';
    'COPY' PasswdFile CvsDbDir Redirection;
    IF (rc = ERROR.NO_ERROR) THEN
       SAY ' Ok.';
    ELSE
    DO
       ErrorMsg = 'Cannot copy passwd file.';
       LEAVE;
    END;

    /* checking some files */
    WorkingDir = CvsWorkRoot'\'Archive;
    rc = DIRECTORY(WorkingDir);
    CALL CHAROUT, '- Retrieving current CVSROOT ...';
    'cvs co CVSROOT' Redirection;
    IF (rc \= ERROR.NO_ERROR) THEN
    DO
       ErrorMsg = 'Cannot retrieve CVSROOT.';
       LEAVE;
    END;
    ELSE
       SAY ' Ok.';

    /* check file contents */
    WorkingDbDir = WorkingDir'\CVSROOT';

    /* - checkout list */
    FileCheckoutList = WorkingDbDir'\checkoutlist';
    rc = SysFileTree( FileCheckoutList, 'File.', 'FO',,'-----');
    IF (FileContains( 'writeinfo', FileCheckoutList)) THEN
       SAY '- skipping addition of writeinfo to checkoutlist: already included.';
    ELSE
    DO
       CALL CHAROUT, '- adding writeinfo to checkoutlist ...';
       rc = LINEOUT( FileCheckoutList, 'writeinfo Cannot checkout writeinfo !');
       rc = LINEOUT( FileCheckoutList);
       SAY ' Ok.';
    END;
    IF (FileContains( 'readinfo', FileCheckoutList)) THEN
       SAY '- skipping addition of readinfo to checkoutlist: already included.';
    ELSE
    DO
       CALL CHAROUT, '- adding readinfo to checkoutlist ...';
       rc = LINEOUT( FileCheckoutList, 'readinfo Cannot checkout readinfo ! (ignore this message for public archives)');
       rc = LINEOUT( FileCheckoutList);
       SAY ' Ok.';
    END;

    /* - writers */
    FileWriters = WorkingDbDir'\writers';
    IF (FileExist(FileWriters)) THEN
       SAY '- skipping creation of file writers: already exists.';
    ELSE
    DO
       CALL CHAROUT, '- creating writers ...';
       rc = LINEOUT( FileWriters, CvsUser);
       rc = LINEOUT( FileWriters);
       'cvs add' FileWriters Redirection;
       SAY ' Ok.';
       fChanged = TRUE;
    END;

    /* - commitinfo */
    FileCommitinfo = WorkingDbDir'\commitinfo';
    IF (FileContains( 'cvssec.cmd', FileCommitinfo)) THEN
    DO
       SAY '!!! WARNING - security configuration of old version found in' FileCommitinfo '!!!';
       SAY 'Please remove manually !';
    END;
    IF (FileContains( 'cvssec.exe', FileCommitinfo)) THEN
       SAY '- skipping addition of cvssec.cmd to commitinfo: already included.';
    ELSE
    DO
       CALL CHAROUT, '- adding security program to commitinfo ...';
       rc = SysFileTree( FileCommitinfo, 'File.', 'FO',,'-----');
       rc = LINEOUT( FileCommitinfo, 'ALL' CvsSecureScript 'CHECKCOMMIT');
       rc = LINEOUT( FileCommitinfo);
       SAY ' Ok.';
       fChanged = TRUE;
    END;

    /* - taginfo */
    FileTaginfo = WorkingDbDir'\taginfo';
    IF (FileContains( 'cvssec.cmd', FileTaginfo)) THEN
    DO
       SAY '!!! WARNING - security configuration of old version found in' FileTaginfo '!!!';
       SAY 'Please remove manually !';
    END;

    IF (FileContains( 'cvssec.exe', FileTaginfo)) THEN
       SAY '- skipping addition of cvssec.exe to taginfo: already included.';
    ELSE
    DO
       CALL CHAROUT, '- adding security program to taginfo ...';
       rc = SysFileTree( FileTaginfo, 'File.', 'FO',,'-----');
       rc = LINEOUT( FileTaginfo, 'ALL' CvsSecureScript 'CHECKTAG');
       rc = LINEOUT( FileTaginfo);
       SAY ' Ok.';
       fChanged = TRUE;
    END;

    /* - writeinfo */
    FileWriteinfo = WorkingDbDir'\writeinfo';
    IF (FileExist( FileWriteinfo)) THEN
       SAY '- skipping creation of writeinfo: already exists.';
    ELSE
    DO
       CALL CHAROUT, '- creating writeinfo ...';
       BaseDir = CvsArchiveRoot'\'Archive;
       rc = SysFileTree( CvsArchiveRoot'\'Archive'\*', 'Subdir.', 'ODS');
       IF (rc \= ERROR.NO_ERROR) THEN
       DO
          ErrorMsg = 'Error in SysFileTree.';
          LEAVE;
       END;

       /* check maxlen of directory */
       MaxLen = 0;
       DO i = 1 TO Subdir.0
          MaxLen = MAX( MaxLen, LENGTH( Subdir.i));
       END;

       /* start with basic directory */
       rc = LINEOUT( FileWriteinfo, LEFT( '/', MaxLen) '*');
       rc = LINEOUT( FileWriteinfo, LEFT( '/CVSROOT', MaxLen) CvsUser);

       /* add all other except CVS directories */
       DO i = 1 TO Subdir.0
          IF ((POS( '\CVS\', Subdir.i) = 0) &,
              (POS( '\CVSROOT', Subdir.i) = 0)) THEN
          DO
             ThisDir = DELSTR( Subdir.i, 1, LENGTH(BaseDir));
             ThisDir = TRANSLATE( ThisDir, '/', '\');
             rc = LINEOUT( FileWriteinfo, LEFT( ThisDir, MaxLen) '*');
          END;
       END;
       'cvs add' FileWriteinfo Redirection;
       SAY ' Ok.';
       fChanged = TRUE;

    END;

    /* turn on writeinfo logging */
    LogFile = CvsArchiveRoot'\'Archive'\CVSROOT\writeinfo.log';
    IF (FileExist( LogFile)) THEN
       SAY '- skipping activation of writeinfo log: already activated.';
    ELSE
    DO
       CALL CHAROUT, '- activating writeinfo log ...';
       rc= LINEOUT( LogFile);
       SAY ' Ok.';
    END;

    /* - config */
    FileConfig = WorkingDbDir'\config';
    IF (ReadKeyValue( FileConfig, 'SystemAuth', 'U') = 'NO') THEN
       SAY '- skipping deactivation of system authentication: already deactivated.';
    ELSE
    DO
       CALL CHAROUT, '- deactivating system authentication ...';
       rc = LINEOUT( FileConfig, '');
       rc = LINEOUT( FileConfig, '# NOSAADM: disable check users/passwords from system');
       rc = LINEOUT( FileConfig, 'SystemAuth=no');
       rc = LINEOUT( FileConfig, '');
       rc = LINEOUT( FileConfig);
       fChanged = TRUE;
       SAY 'Ok.';
    END;

    /* commit the changes */
    IF (fChanged) THEN
    DO
       CALL CHAROUT, '- committing changes to archive ...';
       'CALL cvs commit -m "cvssenv: Added security" CVSROOT' Redirection;
       IF (rc = ERROR.NO_ERROR) THEN
          SAY ' Ok.'
       ELSE
          SAY ' Error !';
    END;

 END;

 RETURN( rc);

/* ========================================================================= */
InitializeArchive: PROCEDURE EXPOSE (GlobalVars);
 PARSE ARG Archive, CvsArchiveRoot, CvsWorkRoot, ArchiveComment;

 /* defaults */
 rc = ERROR.NO_ERROR;

 SAY;
 DO UNTIL (TRUE)

    TmpDir = VALUE( 'TMP',,env);
    IF (TmpDir = '') THEN
    DO
       SAY 'tmp variable not set.';
       rc = ERROR.ENVVAR_NOT_FOUND;
       LEAVE;
    END;


    /* create archive directory */
    ArchiveDir = CvsArchiveRoot'\'Archive;
    IF (\DirExist( ArchiveDir)) THEN
    DO
       rc = CreateArchiveDir( ArchiveDir, 'archive directory');
       IF (rc \= ERROR.NO_ERROR) THEN
          LEAVE;
    END;

    /* create working dir for local access */
    WorkingDir = CvsWorkRoot'\'Archive;
    IF ((CvsWorkRoot \= '') & (\DirExist(WorkingDir))) THEN
    DO
       rc = CreateArchiveDir( WorkingDir, 'working directory');
       IF (rc \= ERROR.NO_ERROR) THEN
          LEAVE;
    END;
    rcx = DIRECTORY( WorkingDir);

    /* initialize CVS archive */
    LogFile = SysTempFileName( TmpDir'\cvsenv.???');
    CALL CHAROUT, '- Initializing archive directory for archive' Archive '... ';
    'CALL cvs init >' LogFile;
    IF (rc = ERROR.NO_ERROR) THEN
       SAY 'Ok.';
    ELSE
    DO
       SAY 'Error!';
       'TYPE' LogFile;
    END;
    rcx = SysFileDelete( LogFile);
    IF (rc \= ERROR.NO_ERROR) THEN
       LEAVE;

    /* wait for CVS (or filesystem ?) to write files */
    rcx = SysSleep( 1)

    /* set archive comment */
    CALL CHAROUT, '- setting archive comment ... ';
    rc = SetArchiveComment( Archive, CvsArchiveRoot, ArchiveComment);
    IF (rc = ERROR.NO_ERROR) THEN
       SAY 'Ok.';
    ELSE
       SAY 'Error!';

    /* change to working dir */
    CALL CHAROUT, '- Adding wrappers for binary files ... ';
    WrapperFile = 'cvswrappers';
    'CALL cvs co .' Redirection;
    'TYPE' CallDir'\samples\'WrapperFile' > CVSROOT\'WrapperFile;
    'CALL cvs commit -m "cvssenv: Added cvswrappers for binary files" CVSROOT\'WrapperFile Redirection;
    IF (rc = ERROR.NO_ERROR) THEN
       SAY 'Ok.';
    ELSE
       SAY 'Error!';


 END;

 RETURN( rc);

/* ========================================================================= */
ImportArchive: PROCEDURE EXPOSE (GlobalVars);
 PARSE ARG Archive, ZipName, CvsArchiveRoot, CvsWorkRoot;

 /* defaults */
 rc = ERROR.NO_ERROR;

 SAY;
 DO UNTIL (TRUE)

    ImportTitle  = 'Import archive file' Zipname 'for archive' Archive':';
    SAY;
    SAY ImportTitle;
    SAY COPIES( '-', LENGTH( ImportTitle));

    /* .............................................................. */

    /* unzip the file to create teh directory structure */
    CALL CHAROUT, 'Create directory tree ... ';
    'CALL UNZIP' ZipName '-x' UnzipExclude Redirection;
    IF (rc \= ERROR.NO_ERROR) THEN
    DO
       ErrorMsg = 'The zip file' ZipName 'could not be unpacked properly.';
       rc = ERROR.INVALID_DATA;
    END;

    /* files are not needed now */
    rc = SysFileTree( '*', 'File.', 'OFS',,'-----');
    IF (rc \= ERROR.NO_ERROR) THEN
    DO
       ErrorMsg = 'Fehler in SysFileTree.';
       rc = ERROR.INVALID_FUNCTION;
       LEAVE;
    END;
    DO i = 1 TO File.0
       rc = SysFileDelete( File.i);
    END;
    SAY 'Ok.';

    /* .............................................................. */

    /* determine new directories */
    CALL CHAROUT, 'Import directory tree ... ';
    rc = SysFileTree( '*', 'File.', 'OD',,'-----');
    IF (rc \= ERROR.NO_ERROR) THEN
    DO
       ErrorMsg = 'Error in SysFileTree.';
       rc = ERROR.INVALID_FUNCTION;
       LEAVE;
    END;

    /* import all directories straight below CVSROOT */
    /* subdirectories are included that way */
    CurrentDir = DIRECTORY();
    DO i = 1 TO File.0
       DirNamePos = LASTPOS('\', File.i);
       rcx = DIRECTORY( File.i);
       DirName = SUBSTR( File.i, DirNamePos + 1);
       'CALL cvs import -m "Import of directory tree"' DirName 'netlabs start' Redirection;
    END;
    rcx = DIRECTORY( CurrentDir);

    /* delete the tree again ... */
    rc = SysFileTree( '*', 'File.', 'ODS',,'-----');
    IF (rc \= ERROR.NO_ERROR) THEN
    DO
       ErrorMsg = 'Error in SysFileTree.';
       rc = ERROR.INVALID_FUNCTION;
       LEAVE;
    END;
    DO i = File.0 to 1 BY -1
       'rd' File.i Redirection;
    END;
    SAY 'Ok.';

    /* ... to check it out. */
    /* Sometimes the checkout does not work */
    /* properly if something exists before  */
    CALL CHAROUT, 'Check out directory tree ... ';
    'CALL cvs co .' Redirection;
    SAY 'Ok.';

    /* .............................................................. */

    /* unzip files again */
    CALL CHAROUT, 'Unpack source files ... ';
    'CALL UNZIP -o ' ZipName '-x' UnzipExclude Redirection;
    IF (rc \= ERROR.NO_ERROR) THEN
    DO
       ErrorMsg = 'The zip file' ZipName 'could not be unpacked properly.';
       rc = ERROR.INVALID_DATA;
    END;

    /* search the files */
    rc = SysFileTree( '*', 'File.', 'OFS',,'-----');
    IF (rc \= ERROR.NO_ERROR) THEN
    DO
       ErrorMsg = 'Error in SysFileTree.';
       rc = ERROR.INVALID_FUNCTION;
    END;
    SAY 'Ok.';
    SAY;

    DO i = 1 TO File.0

       /* ignore CVS management directories */
       IF (POS( '\CVS', File.i) \= 0) THEN
          ITERATE;

       /* assemble some values */
       FileType       = TypeAscii;
       FileName       = File.i;
       FileNamePart   = FILESPEC('N', File.i);
       FileNameExtPos = LASTPOS( '.', FileNamePart);

       /* check if file is already in archive */
       'CALL cvs log' File.i Redirection;
       IF (rc = 0) THEN
       DO
          SAY FileNamePart 'skipped, already in archive.';
          ITERATE;
       END;

       /* determine default file type for extension */
       IF (FileNameExtPos > 0) THEN
       DO
          FileNameExt = TRANSLATE( SUBSTR( FileNamePart, FileNameExtPos));
          IF (FileNameExt \= '') THEN
             FileType    = (WORDPOS( FileNameExt, BinFileTypes) > 0);
       END;
       ELSE
          FileNameExt    = '';

       /* prepare to add a keyword commenline with $Id$ */
       /* get comment char for this file type */
       CommentChar    = '';
       CommentCharEnd = '';
       FileNameExt = LOWER(FileNameExt); /* convert to lower case like they are stored in OS2.INI */

       SELECT
          /* special case: "makefile " */
          WHEN (TRANSLATE( FileNamePart) = 'GNUMAKEFILE') THEN CommentChar = '#';
          WHEN (TRANSLATE( FileNamePart) = 'MAKEFILE') THEN CommentChar = '#';

          /* special case: no extension */
          WHEN (FileNameExt = '')                  THEN NOP;

          /* special case: CMD: is it a rexx script ? */
          WHEN (FileNameExt = '.cmd') THEN
          DO
             FileSig = CHARIN( FileName, 1, 2);
             rcx = STREAM( FileName, 'C', 'CLOSE');
             IF ( FileSig = '/*') THEN
             DO
                CommentChar    = '/*';
                CommentCharEnd = '*/';
             END;
             ELSE
             DO
                CommentChar = SysIni(, IniAppName_Comment, FileNameExt);
                PARSE VAR CommentChar CommentChar"00"x''CommentCharEnd;
             END;
          END /* do */

          /* read from OS2.INI */
          OTHERWISE
          DO
             CommentChar = SysIni(, IniAppName_Comment, FileNameExt);
             ZeroPos = POS( "00"x, CommentChar);
             IF (ZeroPos > 0) THEN
             DO
                CommentCharEnd = SUBSTR( CommentChar, ZeroPos + 1);
                CommentChar    = LEFT( CommentChar, ZeroPos - 1);
             END;
          END;
       END;

       IF (CommentChar = 'ERROR:') THEN
          CommentChar = '';

       /* does the file already have a keyword line ? */
       IF (FileType \= TypeBinary) THEN
       DO
          IF (CommentChar \= '') THEN
          DO
             rcx = SysFileSearch( '$'CvsKeyword, FileName, 'Line.');
             IF ((rcx = ERROR.NO_ERROR) & (Line.0 > 0)) THEN
             DO
                SAY FileNamePart ': file already contains a keyword line.';
             END;
             ELSE
             DO
                Keyword = '$'CvsKeyword'$';
                KeywordLine = CommentChar Keyword CommentCharEnd;
                SAY FileNamePart ': Insert keyword line: ' KeywordLine;

                TmpFile     = FileName'.$$$tmp$$$';
                KeywordFile = FileName'.$$$key$$$';

                'REN' FileName FILESPEC( 'N', TmpFile);
                rc = LINEOUT( KeywordFile, KeywordLine);
                rc = LINEOUT( KeywordFile, '');
                rc = LINEOUT( KeywordFile);
                'COPY' KeywordFile '+' TmpFile FileName Redirection;
                'DEL' KeywordFile TmpFile Redirection;
             END
          END;
          ELSE
             SAY FileNamePart ': No comment character: No keyword line inserted.';
       END;
       ELSE
             SAY FileNamePart ': binary file: No keyword line inserted.';

       /* add file to archive, disable keyword expansion for binary files */
       IF (FileType = TypeBinary) THEN
          KeywordOption = '-kb'
       ELSE
          KeywordOption = '';
       'CALL cvs add' KeywordOption File.i Redirection;
       IF (rc \= ERROR.NO_ERROR) THEN
       DO
          SAY '';
          SAY 'File' File.i ' could not be added to the archive.';
          SAY 'Press Ctrl-Break to cancel or';
          'PAUSE';
       END;

    END; /* DO i = 1 TO File.0 */

    IF (rc \= ERROR.NO_ERROR) THEN
       LEAVE;

    /* .............................................................. */

    /* commit all changes  */
    SAY;
    SAY 'committing all changes to the archive ...';
    'CALL cvs commit -m "Import"'

    /* .............................................................. */
    IF (STRIP(CvsBranches) \= '') THEN
    DO
       SAY;
       SAY  'create branches:';
       /* create branches */
       DO WHILE ( CvsBranches \= '')
          PARSE VAR CvsBranches Branch CvsBranches;
          SAY Branch;
          'CALL CVS tag -b' Branch '.' Redirection;
       END;
       SAY;
    END;

 END;

 RETURN( rc);

/* ========================================================================= */
MakeArchivePrivate: PROCEDURE EXPOSE (GlobalVars);
 PARSE ARG Archive, CvsArchiveRoot, CvsUser;

 /* defaults */
 rc = ERROR.NO_ERROR;

 SAY;
 DO UNTIL (TRUE)
    IF (IsArchivePrivate( Archive, CvsArchiveRoot)) THEN
    DO
       SAY 'archive' Archive 'is already restricted to private access.';
       LEAVE;
    END;

    ImportTitle  = 'Restrict archive' Archive 'to private access:';
    SAY;
    SAY ImportTitle;
    SAY COPIES( '-', LENGTH( ImportTitle));

    /* .............................................................. */

    CALL CHAROUT, 'Creating readinfo file ...';
    PasswdFile  = CallDir'\passwd';
    FileReadInfo = 'CVSROOT\readinfo';
    rcx = SysFileDelete( FileReadInfo);
    rcx = LINEOUT( FileReadInfo, CvsUser);
    IF (FileExist( PasswdFile)) THEN
    DO
       /* add currently defined users */
       DO WHILE (LINES( PasswdFile) > 0)
          ThisDef = LINEIN( PasswdFile);
          PARSE VAR ThisDef ThisUser':'.;
          IF (ThisUser \= CvsUser) THEN
             rcx = LINEOUT( FileReadInfo, ';'ThisUser);
       END;
       rcx = STREAM( PasswdFile, 'C', 'CLOSE');
    END;
    rcx = STREAM( FileReadInfo, 'C', 'CLOSE');
    SAY ' Ok.';

    /* add readers to archive and commit */
    CALL CHAROUT, 'Adding readinfo file to archive ...';
    'cvs add' FileReadInfo Redirection;
    'cvs commit -m "cvssenv: turned archive to private access"' FileReadInfo Redirection;
    IF (rc \= ERROR.NO_ERROR) THEN
    DO
       SAY ' Error !';
       LEAVE;
    END;
    SAY ' Ok.';
    'CALL nosapw -d'
    'CALL cvsenv $CONFIG';

 END;
 RETURN( rc);

/* ========================================================================= */
MakeArchivePublic: PROCEDURE EXPOSE (GlobalVars);
 PARSE ARG Archive, CvsArchiveRoot, CvsUser;

 /* defaults */
 rc = ERROR.NO_ERROR;

 SAY;
 DO UNTIL (TRUE)

    IF (\IsArchivePrivate( Archive, CvsArchiveRoot)) THEN
    DO
       SAY 'archive' Archive 'is already open to public access.';
       LEAVE;
    END;

    ImportTitle  = 'Open archive' Archive 'to public access:';
    SAY;
    SAY ImportTitle;
    SAY COPIES( '-', LENGTH( ImportTitle));

    /* .............................................................. */

    CALL CHAROUT, 'Removing readinfo file ...';
    FileReadInfo = 'CVSROOT\readinfo';
    rcx = SysFileDelete( FileReadInfo);
    'cvs remove' FileReadInfo Redirection;
    'cvs commit -m "cvssenv: turned archive to public access"' FileReadInfo Redirection;
    IF (rc \= ERROR.NO_ERROR) THEN
    DO
       SAY ' Error !';
       LEAVE;
    END;
    SAY ' Ok.';

    /* make sure to delete also plain textfiles from CVS db directory */
    rcx = SysFileDelete( CvsArchiveRoot'\'Archive'\'FileReadInfo);

    'CALL nosapw -d'
    'CALL cvsenv $CONFIG';

 END;

 RETURN( rc);


/* ========================================================================= */
GetExportedArchives: PROCEDURE EXPOSE (GlobalVars);
 PARSE ARG ListFile;

 Archives = '';
 DO WHILE (LINES( ArchiveList) > 0)
    Archives = Archives FILESPEC( 'N', WORD( LINEIN( ArchiveList), 1));
 END;
 rcx = STREAM( ArchiveList, 'C', 'CLOSE');
 RETURN( Archives);

/* ========================================================================= */
ListArchives: PROCEDURE EXPOSE (GlobalVars);
 PARSE ARG CvsArchiveRoot;

 Archive.0  = 0;
 NameMaxLen = 12;
 ExportedArchives = TRANSLATE( GetExportedArchives());

 DO UNTIL (TRUE)

    /* search all archive base directories */
    rc = SysFileTree( CvsArchiveRoot'\*', 'Dir.', 'DO');
    IF (rc \= ERROR.NO_ERROR) THEN
    DO
       SAY;
       SAY CmdName': error in SysfileTree. rc='rc;
       LEAVE;
    END;

    /* get all archives */
    DO d = 1 TO Dir.0
       IF (\FileExist( Dir.d'\CVSROOT\*')) THEN
          ITERATE;

       /* store archive */
       a                    = Archive.0 + 1;
       Archive.0            = a;
       Archive.a            = FILESPEC( 'N', Dir.d);
       Archive.a.fIsPrivate = IsArchivePrivate( Archive.a, CvsArchiveRoot);
       Archive.a.Comment    = GetArchiveComment( Archive.a, CvsArchiveRoot);
       NameMaxLen = MAX( NameMaxLen, LENGTH( Archive.a));
    END;


    IF (Archive.0 = 0) THEN
       SAY 'no archives present yet.';
    ELSE
    DO
       SAY 'status ' LEFT( 'archive', NameMaxLen) 'comment';
       SAY '-------' COPIES( '-', NameMaxLen)     '---------------------------';
       DO a = 1 TO Archive.0

          SELECT
             WHEN (Archive.a.fIsPrivate) THEN
                Status = 'private'

             OTHERWISE
                Status = 'public ';
          END;

          SAY Status LEFT( Archive.a, NameMaxLen) Archive.a.Comment;
       END;
    END;
 END;
 SAY;

 RETURN( ERROR.NO_ERROR);

/* ========================================================================= */
SetArchiveComment: PROCEDURE EXPOSE (GlobalVars);
 PARSE ARG Archive, CvsArchiveRoot, ArchiveComment;

 CommentFile = CvsArchiveRoot'\'Archive'\CVSROOT\projectinfo';
 rcx = SysFileDelete( CommentFile);
 rc = LINEOUT( CommentFile, ArchiveComment);
 rcx = STREAM( CommentFile, 'C', 'CLOSE');
 RETURN( ERROR.NO_ERROR);

/* ========================================================================= */
EditArchiveComment: PROCEDURE EXPOSE (GlobalVars);
 PARSE ARG Archive, CvsArchiveRoot, ArchiveComment;

 ArchiveComment = STRIP(PullVariable( ArchiveComment, 'Enter the comment for this archive:'));
 RETURN( SetArchiveComment( Archive, CvsArchiveRoot, ArchiveComment));

/* ========================================================================= */
GetArchiveComment: PROCEDURE EXPOSE (GlobalVars);
 PARSE ARG Archive, CvsArchiveRoot;

 CommentFile = CvsArchiveRoot'\'Archive'\CVSROOT\projectinfo';
 ArchiveComment = LINEIN( CommentFile);
 rcx = STREAM( CommentFile, 'C', 'CLOSE');
 RETURN( ArchiveComment);

/* ========================================================================= */
IsArchivePrivate: PROCEDURE EXPOSE (GlobalVars);
 PARSE ARG Archive, CvsArchiveRoot;

 RETURN( FileExist( CvsArchiveRoot'\'Archive'\CVSROOT\readinfo,v'));

/* ========================================================================= */
SetCvsService: PROCEDURE EXPOSE (GlobalVars);
 PARSE ARG NewStatus, StopFile;

 rc = ERROR.NO_ERROR;

 /* determine current status */
 rcx = SysFileTree( StopFile, 'File.', 'F',, '-----');
 NewStatus = TRANSLATE( STRIP( NewStatus));
 fStopped  = FileExist( StopFile);

 SELECT
    WHEN (NewStatus = 'PAUSE') THEN
    DO
       Action = 'paused';
       IF (fStopped) THEN
          rc = ERROR.ACCESS_DENIED;
       ELSE
       DO
          rcx = LINEOUT( StopFile);
          rc = (\FileExist( StopFile));
       END;
    END;

    WHEN (NewStatus = 'RESUME') THEN
    DO
       Action = 'resumed';
       IF (\fStopped) THEN
          rc = ERROR.ACCESS_DENIED;
       ELSE
       DO
          rcx = SysFileDelete( StopFile);
          rc = FileExist( StopFile);
       END;
    END;

    OTHERWISE NOP;
 END;

 Service = 'NOSAADM CVS service';
 SELECT
    WHEN (rc = ERROR.NO_ERROR)      THEN SAY Service Action'.';
    WHEN (rc = ERROR.ACCESS_DENIED) THEN SAY Service 'already' Action'.';
    OTHERWISE                            SAY Service 'could not be' Action'.';
 END;

 RETURN(0);

/* ========================================================================= */
ClearArchiveDirectories: PROCEDURE EXPOSE (GlobalVars) CvsArchiveRoot CvsWorkRoot CvsSnapshotRoot CvsBackupRoot;
 PARSE ARG Archive, fRemove;

 IF (fRemove) THEN
    Action = 'removed';
 else
    Action = 'cleared';

 SAY;
 SAY 'CAUTION - all directories for archive' Archive' will be'  Action'!';
 SAY;
 SAY 'PRESS ENTER 4 TIMES OR PRESS CTRL-BREAK TO EXIT THIS PROCEDURE:';
 SAY;
 'PAUSE';
 'PAUSE';
 'PAUSE';
 SAY;
 SAY 'Last chance: PRESS  CTRL-BREAK  TO EXIT !!!';
 SAY;
 'PAUSE';
 SAY;

 /* change from directories to be deleted */
 rcx = DIRECTORY( CvsArchiveRoot);

 rc1 = ClearDirectory( CvsArchiveRoot'\'Archive, fRemove);
 IF (rc1 \= ERROR.NO_ERROR) THEN
    SAY 'The archive directory for' Archive 'could not be' Action'.';

 rc2 = ClearDirectory( CvsWorkRoot'\'Archive, fRemove);
 IF (rc2 \= ERROR.NO_ERROR) THEN
    SAY 'The working directory for' Archive 'could not be' Action'.';

 rc3 = ClearDirectory( CvsSnapshotRoot'\'Archive, fRemove);
 IF (rc3 \= ERROR.NO_ERROR) THEN
    SAY 'The snapshot directory for' Archive 'could not be' Action'.';

 rc4 = ClearDirectory( CvsBackupRoot'\'Archive, fRemove);
 IF (rc4 \= ERROR.NO_ERROR) THEN
    SAY 'The backup directory for' Archive 'could not be' Action'.';

 SAY;

 SELECT
    WHEN (rc1 > 0) THEN rc = rc1;
    WHEN (rc2 > 0) THEN rc = rc2;
    WHEN (rc3 > 0) THEN rc = rc3;
    WHEN (rc4 > 0) THEN rc = rc4;
    OTHERWISE           rc = ERROR.NO_ERROR;
 END;

 RETURN( rc);

/* ========================================================================= */
ReadKeyValue: PROCEDURE EXPOSE (GlobalVars)
 PARSE ARG File, KeyName, ReadOptions;

 KeyValue  = '';
 CheckName = TRANSLATE( STRIP( KeyName));
 CheckOptions = TRANSLATE( ReadOptions);

 DO UNTIL (TRUE)
    /* search key */
    rc = SysFileSearch( KeyName'=', File, 'FoundLine.');
    DO i = 1 TO FoundLine.0
       PARSE VAR FoundLine.i ThisKey'='ThisValue;
       IF (TRANSLATE( STRIP( ThisKey)) = CheckName) THEN
       DO
          KeyValue = STRIP( ThisValue);
          LEAVE;
       END;
    END;

    /* perform options */
    IF (POS( 'U', ReadOptions) > 0) THEN
       KeyValue = TRANSLATE( KeyValue);
 END;

 RETURN( KeyValue);

/* ========================================================================= */
WriteKeyValue: PROCEDURE EXPOSE (GlobalVars)
 PARSE ARG File, KeyName, ReadOptions;

 KeyValue  = '';
 CheckName = TRANSLATE( STRIP( KeyName));
 CheckOptions = TRANSLATE( ReadOptions);

 DO UNTIL (TRUE)
    /* search key */
    rc = SysFileSearch( KeyName'=', File, 'FoundLine.');
    DO i = 1 TO FoundLine.0
       PARSE VAR FoundLine.i ThisKey'='ThisValue;
       IF (TRANSLATE( STRIP( ThisKey)) = CheckName) THEN
       DO
          KeyValue = STRIP( ThisValue);
          LEAVE;
       END;
    END;

    /* perform options */
    IF (POS( 'U', ReadOptions) > 0) THEN
       KeyValue = TRANSLATE( KeyValue);
 END;

 RETURN( KeyValue);