home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 8 Other / 08-Other.zip / nosaa107.zip / cvsenv.cmd next >
OS/2 REXX Batch file  |  1999-11-11  |  57KB  |  1,857 lines
  1. /*
  2.  *      CVSENV.CMD - V1.07 - NOSA Administrator - C.Langanke@TeamOS2.DE - 1999
  3.  *
  4.  *     Syntax: cvsenv [archive_name] action [option]
  5.  *
  6.  *       archive_name - name of the archive directory
  7.  *
  8.  *     Valid actions are (lowercase letters optional):
  9.  *     (no option)|$Work   - brings you to the working directory of a project
  10.  *     $Bin                - brings you back to the bin directory of NOSAADM
  11.  *     $Archive            - brings you to the archive directory tree of a project
  12.  *     $List               - lists all available archives and their publicity status
  13.  *     $Init               - sets up and initialises a new archive
  14.  *     $Reinit             - resets to an empty archive (includes $CLEARWORK)
  15.  *     $COMment [comment]  - sets the archive comment
  16.  *     $Private            - restrict an archive to private access
  17.  *     $CLearwork          - empties working directory completely
  18.  *     $IMport zipname     - imports files from within a zip archive file
  19.  *                           NOTE: working directory must be empty !
  20.  *     $Secure             - installs security for an archive
  21.  *                           If no comment is specified, cvsenv will prompt for one
  22.  *     $BAckup             - creates a backup zip file of the archive within
  23.  *                           directory <CVS_BACKUPROOT>\<archive_name>.
  24.  *     $SNapshot [tagname] - creates snapshot zip file within directory
  25.  *                           <CVS_SNAPSHOTROOT>\<archive_name>, existing zip
  26.  *                           files are replaced.
  27.  *     $Genlog             - creates or continues a changelog. This command
  28.  *                           temporarily checks out the current archive (cvs co .) !
  29.  *     $Config             - sets up the CVS service within TCP/IP configuration and
  30.  *                           rewrites cvsservice.cmd and archives.lst
  31.  */
  32. /* First comment is used as help text */
  33.  
  34.  SIGNAL ON HALT
  35.  
  36.  TitleLine = STRIP(SUBSTR(SourceLine(2), 3));
  37.  PARSE VAR TitleLine CmdName'.CMD 'Info
  38.  Title     = CmdName Info
  39.  
  40.  env          = 'OS2ENVIRONMENT';
  41.  TRUE         = (1 = 1);
  42.  FALSE        = (0 = 1);
  43.  Redirection  = '> NUL 2>&1';
  44.  CrLf         = "0d0a"x;
  45.  '@ECHO OFF'
  46.  
  47.  /* OS/2 errorcodes */
  48.  ERROR.NO_ERROR           =  0;
  49.  ERROR.INVALID_FUNCTION   =  1;
  50.  ERROR.FILE_NOT_FOUND     =  2;
  51.  ERROR.PATH_NOT_FOUND     =  3;
  52.  ERROR.ACCESS_DENIED      =  5;
  53.  ERROR.NOT_ENOUGH_MEMORY  =  8;
  54.  ERROR.INVALID_FORMAT     = 11;
  55.  ERROR.INVALID_DATA       = 13;
  56.  ERROR.NO_MORE_FILES      = 18;
  57.  ERROR.WRITE_FAULT        = 29;
  58.  ERROR.READ_FAULT         = 30;
  59.  ERROR.GEN_FAILURE        = 31;
  60.  ERROR.INVALID_PARAMETER  = 87;
  61.  ERROR.ENVVAR_NOT_FOUND   = 203;
  62.  
  63.  GlobalVars = 'Title CmdName env TRUE FALSE Redirection ERROR.';
  64.  SAY;
  65.  
  66.  /* load RexxUtil */
  67.  CALL RxFuncAdd    'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs';
  68.  CALL SysLoadFuncs;
  69.  
  70.  /* Defaults */
  71.  GlobalVars = GlobalVars 'CallDir UnzipExclude BinFileTypes CvsKeyword CvsBranches ArchiveCommentFile';
  72.  CallDir    = GetCallDir();
  73.  CurrentDir = DIRECTORY();
  74.  
  75.  ArchiveCommentFile = 'archivecomment';
  76.  ArchiveComment     = '';
  77.  ProjectInfoFile    = 'CVSROOT\projectinfo';
  78.  
  79.  BinFileTypes = '.BMP .GIF .JPG .ICO .ZIP .PTR .CUR .ANI .AND .PCX .TGA .TIF';
  80.  UnzipExclude = '*.obj *.exe *.map *.msg *.res */CVS/*';
  81.  
  82.  IniAppName         = 'NOSAADM';
  83.  IniAppName_Comment = 'NOSAADM_COMMENTS';
  84.  
  85.  ArchiveVarname     = 'NOSAADM_ARCHIVE';
  86.  
  87.  GuestAccount = 'guest readonly';
  88.  
  89.  rc = ERROR.NO_ERROR;
  90.  
  91.  TypeBinary       = TRUE;
  92.  TypeAscii        = FALSE;
  93.  
  94.  fInitArchive     = FALSE;
  95.  fImportArchive   = FALSE;
  96.  fSecureArchive   = FALSE;
  97.  fCreateSnapshot  = FALSE;
  98.  fCreateBackup    = FALSE;
  99.  fGenerateLog     = FALSE;
  100.  fMakePrivate     = FALSE;
  101.  ErrorMsg         = '';
  102.  
  103.  CvsKeyword       = 'Id';
  104.  CvsBranches      = '';
  105.  
  106.  /* show help */
  107.  ARG Parm .
  108.  IF ((Parm = '') | (POS('?', Parm) > 0)) THEN
  109.  DO
  110.     rc = SetCVSPath( ReadIniValue(, IniAppName, 'CVS_BINROOT'));
  111.     rc = ShowHelp();
  112.     EXIT(ERROR.INVALID_PARAMETER);
  113.  END;
  114.  
  115.  
  116.  DO UNTIL (TRUE)
  117.  
  118.     /* -------------------------------------------------------------- */
  119.  
  120.     /* initialise */
  121.     BinFileTypes = TRANSLATE( BinFileTypes); /* nur zur Sicherheit */
  122.  
  123.     /* read some vars from ini */
  124.     CvsHostname     = ReadIniValue(, IniAppName, 'CVS_HOSTNAME');
  125.     CvsArchiveRoot  = ReadIniValue(, IniAppName, 'CVS_ARCHIVEROOT');
  126.     CvsWorkRoot     = ReadIniValue(, IniAppName, 'CVS_WORKROOT');
  127.     CvsSnapshotRoot = ReadIniValue(, IniAppName, 'CVS_SNAPSHOTROOT');
  128.     CvsBackupRoot   = ReadIniValue(, IniAppName, 'CVS_BACKUPROOT');
  129.     CvsInitCommand  = ReadIniValue(, IniAppName, 'CVS_INITCOMMAND');
  130.     CvsBinRoot      = ReadIniValue(, IniAppName, 'CVS_BINROOT');
  131.     CvsExe          = ReadIniValue(, IniAppName, 'CVS_EXE');
  132.     CvsUser         = ReadIniValue(, IniAppName, 'CVS_USER');
  133.  
  134.     MissingVar = '';
  135.     SELECT
  136.        WHEN (CvsHostname     = '') THEN MissingVar = 'hostname for this server';
  137.        WHEN (CvsArchiveRoot  = '') THEN MissingVar = 'root directory for archive directories';
  138.        WHEN (CvsWorkRoot     = '') THEN MissingVar = 'root directory for working directories';
  139.        WHEN (CvsSnapshotRoot = '') THEN MissingVar = 'root directory for snapshot directories';
  140.        WHEN (CvsBackupRoot   = '') THEN MissingVar = 'root directory for backup directories';
  141.        WHEN (CvsHome         = '') THEN MissingVar = 'homedirectory';
  142.        WHEN (CvsUser         = '') THEN MissingVar = 'user id';
  143.        OTHERWISE NOP;
  144.     END;
  145.  
  146.     IF (MissingVar \= '') THEN
  147.     DO
  148.        ErrorMsg = 'The' MissingVar 'is not defined.' CRLF||,
  149.                   'Run INSTALL.CMD first.';
  150.        rc = ERROR.ENVVAR_NOT_FOUND
  151.        LEAVE;
  152.     END;
  153.  
  154.     /* is a precommand given ? */
  155.     IF (CvsInitCommand \= '') THEN
  156.        'CALL' CvsInitCommand;
  157.  
  158.     /* make CVS binaries available */
  159.     rc = SetCVSPath( ReadIniValue(, IniAppName, 'CVS_BINROOT'));
  160.     IF (rc \= ERROR.NO_ERROR) THEN
  161.        LEAVE;
  162.  
  163.     /* search unzip */
  164.     fUnzipFound = (SysSearchPath('PATH', 'UNZIP.EXE') \= '');
  165.  
  166.     IF (\fUnzipFound) THEN
  167.     DO
  168.        ErrorMsg = 'unzip.exe could not be found!';
  169.        rc = ERROR.FILE_NOT_FOUND;
  170.        LEAVE;
  171.     END;
  172.  
  173.     /* -------------------------------------------------------------- */
  174.  
  175.     /* check parms */
  176.     ArchiveVar = VALUE( ArchiveVarname, '', env);
  177.     PARSE ARG Archive Action Option;
  178.     Archive = STRIP( Archive);
  179.     SELECT
  180.        WHEN (LEFT(Archive, 1) = '$') THEN
  181.        DO
  182.           PARSE ARG  Action Option;
  183.           Archive = STRIP( ArchiveVar);
  184.        END;
  185.  
  186.        OTHERWISE
  187.      END;
  188.  
  189.      OptionValue = Option;
  190.      Option      = STRIP(TRANSLATE( Option));
  191.      Action      = TRANSLATE( Action);
  192.  
  193.     /* - set ARCHIVE */
  194.     rcx = VALUE( ArchiveVarname, Archive, env);
  195.  
  196.  
  197.     Action  = STRIP( Action);
  198.     Option  = STRIP( Option);
  199.  
  200.     SELECT
  201.  
  202.        WHEN (Action = '$') THEN
  203.        DO
  204.           ErrorMsg = 'Invalid action specified';
  205.           rc = ERROR.INVALID_PARAMETER;
  206.        END;
  207.  
  208.  
  209.        WHEN (POS(Action, '$WORK') = 1) THEN
  210.           Action = '';
  211.  
  212.        WHEN (POS(Action, '$BIN') = 1) THEN
  213.        DO
  214.           rcx = DIRECTORY( Calldir);
  215.           rc = ERROR.NO_ERROR;
  216.           LEAVE;
  217.        END;
  218.  
  219.        WHEN (POS(Action, '$CONFIG') = 1) THEN
  220.        DO
  221.           ErrorMsg = 'The CVS service could not be setup.';
  222.           rc = SetupCVSService( CvsArchiveRoot, CvsExe, CvsHostName);
  223.           RETURN(rc);
  224.        END;
  225.  
  226.        WHEN (POS(Action, '$LIST') = 1) THEN
  227.        DO
  228.           rc = ListArchives( CvsArchiveRoot);
  229.           LEAVE;
  230.        END;
  231.  
  232.        WHEN ((Archive = '') | (POS(LEFT(Archive, 1),'$') > 0 )) THEN
  233.        DO
  234.           ErrorMsg = 'No archive name specified.';
  235.           rc = ERROR.INVALID_PARAMETER;
  236.        END;
  237.  
  238.        WHEN (POS(Action, '$ARCHIVE') = 1) THEN
  239.        DO
  240.           rcx = DIRECTORY( CvsArchiveRoot'\'Archive);
  241.           rc = ERROR.NO_ERROR;
  242.           LEAVE;
  243.        END;
  244.  
  245.        WHEN (POS(Action, '$INIT') = 1) THEN
  246.        DO
  247.           IF (FileExist( CvsArchiveRoot'\'Archive'\CVSROOT\*')) THEN
  248.              SAY 'Warning: working directory for archive' Archive 'already exists';
  249.           ELSE
  250.              fInitArchive = TRUE;
  251.        END;
  252.  
  253.        WHEN (POS(Action, '$PRIVATE') = 1) THEN
  254.        DO
  255.              fMakePrivate = TRUE;
  256.        END;
  257.  
  258.        /* archive exists ? */
  259.        WHEN (\DirExist( CvsArchiveRoot'\'Archive'\CVSROOT')) THEN
  260.        DO
  261.           SAY 'error: archive directory for archive' Archive 'does not exist.';
  262.           rc = ERROR.PATH_NOT_FOUND;
  263.           RETURN( rc);
  264.        END;
  265.  
  266.        WHEN (POS(Action, '$SECURE') = 1) THEN
  267.        DO
  268.           fSecureArchive = TRUE;
  269.        END;
  270.  
  271.        WHEN (POS(Action, '$GENLOG') = 1) THEN
  272.        DO
  273.           fGenerateLog = TRUE;
  274.        END;
  275.  
  276.        /* place COMMENT after CONFIG ! */
  277.        WHEN (POS(Action, '$COMMENT') = 1) THEN
  278.        DO
  279.           ErrorMsg = 'The comment for archive' Archive 'could not be set.';
  280.           IF (OptionValue = '') THEN
  281.              rc = EditArchiveComment( Archive, CvsArchiveRoot, GetArchiveComment( Archive, CvsArchiveRoot));
  282.  
  283.           ELSE
  284.              rc = SetArchiveComment( Archive, CvsArchiveRoot, OptionValue);
  285.           LEAVE;
  286.        END;
  287.  
  288.        /* place CLEARWORK after CONFIG ! */
  289.        WHEN (POS(Action, '$CLEARWORK') = 1) THEN
  290.        DO
  291.           ErrorMsg = 'The working directory for' Archive 'could not be cleared.';
  292.           rc = ClearDirectory( CvsWorkRoot'\'Archive);
  293.           LEAVE;
  294.        END;
  295.  
  296.  
  297.        /* place SNAPSHOT after SECURE ! */
  298.        WHEN (POS(Action, '$SNAPSHOT') = 1) THEN
  299.        DO
  300.           fCreateSnapshot = TRUE;
  301.           RevisionName    = Option;
  302.        END;
  303.  
  304.        WHEN (POS(Action, '$BACKUP') = 1) THEN
  305.        DO
  306.           fCreateBackup = TRUE;
  307.        END;
  308.  
  309.        WHEN (POS(Action, '$REINIT') = 1) THEN
  310.        DO
  311.           /* save current archive comment for reinit */
  312.           ArchiveComment = GetArchiveComment( Archive, CvsArchiveRoot);
  313.  
  314.           /* delete all current files */
  315.           ErrorMsg = 'The working directory for' Archive 'could not be cleared.';
  316.           rc = ClearDirectory( CvsWorkRoot'\'Archive);
  317.           IF (rc \= ERROR.NO_ERROR) THEN
  318.              LEAVE;
  319.           ErrorMsg = 'The archive directory for' Archive 'could not be cleared.';
  320.           rc = ClearDirectory( CvsArchiveRoot'\'Archive);
  321.           IF (rc \= ERROR.NO_ERROR) THEN
  322.              LEAVE;
  323.           SAY;
  324.           fInitArchive = TRUE;
  325.        END;
  326.  
  327.        /* place IMPORT after INIT ! */
  328.        WHEN (POS(Action, '$IMPORT') = 1) THEN
  329.        DO
  330.           DO UNTIL (TRUE)
  331.  
  332.              ImportName = OptionValue;
  333.  
  334.              /* zip file is required */
  335.              IF (ImportName = '') THEN
  336.              DO
  337.                 ErrorMsg = 'No zip file or directory specified for import.';
  338.                 rc = ERROR.FILE_NOT_FOUND;
  339.                 LEAVE;
  340.              END;
  341.              IF (\FileExist( ImportName)) THEN
  342.              DO
  343.                 ErrorMsg = 'zip file or directory' ImportName 'could not be found.';
  344.                 rc = ERROR.PATH_NOT_FOUND;
  345.                 LEAVE;
  346.              END;
  347.  
  348.              fImportArchive = TRUE;
  349.  
  350.              /* working dir must be empty !. Easy way */
  351.              /* to ensure all data is committed       */
  352.              rc = SysFileTree( CvsWorkRoot'\'Archive'\*', 'File.', 'FOS');
  353.              IF ((rc \= 0) | (File.0 > 0)) THEN
  354.              DO
  355.                 ErrorMsg = 'The working directory' Archive 'is not empty.';
  356.                 rc = ERROR.ACCESS_DENIED;
  357.              END;    ;
  358.  
  359.           END;
  360.  
  361.        END; /* WHEN */
  362.  
  363.        WHEN (Action \= '') THEN
  364.        DO
  365.           ErrorMsg = 'invalid option specified.';
  366.           rc = ERROR.INVALID_PARAMETER;
  367.        END;
  368.  
  369.        WHEN (\FileExist( CvsArchiveRoot'\'Archive'\CVSROOT\*')) THEN
  370.        DO
  371.           ErrorMsg = 'The working directory' Archive 'could not be found.';
  372.           rc = ERROR.PATH_NOT_FOUND;
  373.        END;
  374.  
  375.        OTHERWISE NOP;
  376.  
  377.     END;
  378.  
  379.     IF (rc \= ERROR.NO_ERROR) THEN
  380.        LEAVE;
  381.  
  382.     /* ################################################################################### */
  383.  
  384.     /* set up environment */
  385.     CALL CHAROUT, 'Initialize environment for archive' Archive '... ';
  386.  
  387.  
  388.     /* extend path to this directory, making cvsenv available */
  389.     AddToPath = CallDir';';
  390.     CurrentPath = VALUE( 'PATH',,env);
  391.     IF (POS( AddToPath, CurrentPath) = 0) THEN
  392.     DO
  393.        /* - extend PATH */
  394.        rcx = VALUE('PATH', AddToPath''CurrentPath,env);
  395.  
  396.        /* - extend LIBPATH */
  397.        'SET BEGINLIBPATH='AddToPath'%BEGINLIBPATH%';
  398.     END;
  399.  
  400.     /* - set USER */
  401.     rcx = VALUE( 'USER', CvsUser, env);
  402.  
  403.     /* - set CVSROOT */
  404.     rcx = VALUE( 'CVSROOT', ':local:'CvsArchiveRoot'\'Archive, env);
  405.     SAY 'Ok.';
  406.  
  407.     /* .............................................................. */
  408.  
  409.     /* create backup zip */
  410.     IF (fCreateBackup) THEN
  411.     DO
  412.        ErrorMsg = 'The backup for' Archive 'could not be created.';
  413.        rc = CreateBackup( Archive, CvsBackupRoot, CvsArchiveRoot);
  414.        LEAVE;
  415.     END;
  416.  
  417.     /* .............................................................. */
  418.  
  419.     /* generate log */
  420.     IF (fGenerateLog) THEN
  421.     DO
  422.        /* update local directory first */
  423.        CALL CHAROUT, 'Checking out/updating current archive contents ... ';
  424.        'CALL cvs co .' Redirection;
  425.        IF (rc = ERROR.NO_ERROR) THEN
  426.        DO
  427.           SAY 'Ok.';
  428.  
  429.           /* call external routine */
  430.           rc = cvsgenlog( Option);
  431.        END;
  432.        ELSE
  433.           SAY 'Error !';
  434.  
  435.        rc = ERROR.NO_ERROR;
  436.        LEAVE;
  437.     END;
  438.  
  439.     /* .............................................................. */
  440.  
  441.     /* create snapshot zip */
  442.     IF (fCreateSnapshot) THEN
  443.     DO
  444.        ErrorMsg = 'The snapshot for' Archive 'could not be created.';
  445.        rc = CreateSnapshot( Archive, CvsSnapshotRoot, RevisionName);
  446.        LEAVE;
  447.     END;
  448.  
  449.     /* .............................................................. */
  450.  
  451.     /* secure archive */
  452.     IF (fSecureArchive) THEN
  453.     DO
  454.        ErrorMsg = 'The archive' Archive 'could not be created.';
  455.        rc = SecureArchive( Archive, CvsArchiveRoot, CvsWorkRoot, CvsUser);
  456.        LEAVE;
  457.     END; /* IF (fSecureArchive) THEN */
  458.  
  459.     /* .............................................................. */
  460.  
  461.     /* initialise new archive */
  462.     IF (fInitArchive) THEN
  463.     DO
  464.        ErrorMsg = 'The archive' Archive 'could not be initialized.';
  465.        rc = InitializeArchive( Archive, CvsArchiveRoot, CvsWorkRoot, ArchiveComment);
  466.        LEAVE;
  467.     END;
  468.  
  469.  
  470.     /* change to local working dir for archive */
  471.     IF (CvsWorkRoot \= '') THEN
  472.        rcx = DIRECTORY( CvsWorkRoot'\'Archive);
  473.  
  474.     /* .............................................................. */
  475.  
  476.     /* import zip archive file */
  477.     IF (fImportArchive) THEN
  478.     DO
  479.        ErrorMsg = 'The import could not be completed.';
  480.        rc = ImportArchive( Archive, ImportName, CvsArchiveRoot, CvsWorkRoot);
  481.        LEAVE;
  482.  
  483.     END; /* IF (fImportArchive) THEN */
  484.  
  485.     /* .............................................................. */
  486.  
  487.     /* make archive private */
  488.     IF (fMakePrivate) THEN
  489.     DO
  490.        ErrorMsg = 'The archive could not be turned to private.';
  491.        rc = MakeArchivePrivate( Archive, CvsArchiveRoot, CvsUser);
  492.        LEAVE;
  493.  
  494.     END; /* IF (fMakePrivate) THEN */
  495.  
  496.  END;
  497.  
  498.  /* exit */
  499.  IF (rc \= ERROR.NO_ERROR) THEN
  500.  DO
  501.     SAY;
  502.     SAY CmdName': Error:' ErrorMsg;
  503.     'PAUSE'
  504.  END;
  505.  EXIT( rc);
  506.  
  507.  
  508. /* ------------------------------------------------------------------------- */
  509. HALT:
  510.  SAY;
  511.  SAY 'Interrupted by user.';
  512.  EXIT(ERROR.GEN_FAILURE);
  513.  
  514. /* ------------------------------------------------------------------------- */
  515. ShowHelp: PROCEDURE EXPOSE (GlobalVars)
  516.  
  517.  SAY Title;
  518.  SAY;
  519.  
  520.  PARSE SOURCE . . ThisFile
  521.  
  522.  DO i = 1 TO 3
  523.     rc = LINEIN(ThisFile);
  524.  END;
  525.  
  526.  ThisLine = LINEIN(Thisfile);
  527.  DO WHILE (ThisLine \= ' */')
  528.     SAY SUBSTR(ThisLine, 7);
  529.     ThisLine = LINEIN(Thisfile);
  530.  END;
  531.  
  532.  rc = LINEOUT(Thisfile);
  533.  
  534.  RETURN('');
  535.  
  536. /* ------------------------------------------------------------------------- */
  537. FileExist: PROCEDURE
  538.  PARSE ARG FileName
  539.  
  540.  RETURN(STREAM(Filename, 'C', 'QUERY EXISTS') > '');
  541.  
  542. /* ------------------------------------------------------------------------- */
  543. LOWER: PROCEDURE
  544.  
  545.  Lower = 'abcdefghijklmnopqrstuvwxyzäöü';
  546.  Upper = 'ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ';
  547.  
  548.  PARSE ARG String
  549.  RETURN(TRANSLATE(String, Lower, Upper));
  550.  
  551. /* -------------------------------------------------------------------------- */
  552. GetDirName: PROCEDURE
  553.  PARSE ARG Name
  554.  
  555.  /* save environment */
  556.  CurrentDrive = FILESPEC('D', DIRECTORY());
  557.  CurrentDir   = DIRECTORY(FILESPEC('D', Name));
  558.  
  559.  /* try directory */
  560.  DirFound  = DIRECTORY(Name);
  561.  
  562.  /* reset environment */
  563.  rc = DIRECTORY(CurrentDir);
  564.  rc = DIRECTORY(CurrentDrive);
  565.  
  566.  RETURN( DirFound);
  567.  
  568. /* ========================================================================= */
  569. ReadIniValue: PROCEDURE
  570. PARSE ARG IniFile, IniAppname, IniKeyName
  571.  
  572.  IniValue = SysIni(IniFile, IniAppname, IniKeyName);
  573.  IF (IniValue = 'ERROR:') THEN
  574.     IniValue = '';
  575.  
  576.  IF ((IniValue \= '') & (RIGHT(IniValue, 1) = "00"x)) THEN
  577.     IniValue = LEFT( IniValue, LENGTH( IniValue) - 1);
  578.  
  579.  RETURN( IniValue);
  580.  
  581. /* ========================================================================= */
  582. CreateArchiveDir: PROCEDURE EXPOSE (GlobalVars)
  583.  PARSE ARG Pathname, Title
  584.  
  585.  CALL CHAROUT, '- Creating' Title ' ... ';
  586.  rc = SysMkDir( PathName);
  587.  IF (rc = ERROR.NO_ERROR) THEN
  588.     SAY 'Ok.';
  589.  ELSE
  590.     SAY 'Error!';
  591.  RETURN(rc);
  592.  
  593. /* ------------------------------------------------------------------------- */
  594. GetCalldir: PROCEDURE
  595. PARSE SOURCE . . CallName
  596.  CallDir = FILESPEC('Drive', CallName)||FILESPEC('Path', CallName);
  597.  RETURN(LEFT(CallDir, LENGTH(CallDir) - 1));
  598.  
  599. /* ------------------------------------------------------------------------- */
  600. PullVariable: PROCEDURE
  601.  PARSE ARG Default, Message
  602.  
  603.  SAY;
  604.  CALL CHAROUT, Message '['Default'] : ';
  605.  PARSE PULL PullVar;
  606.  IF (LENGTH(PullVar) > 0) THEN
  607.     RETURN(PullVar);
  608.  ELSE
  609.     RETURN(Default);
  610.  
  611.  /* ------------------------------------------------------------------------- */
  612. DirExist: PROCEDURE
  613.  PARSE ARG Dirname
  614.  
  615.  IF (Dirname = '') THEN
  616.     RETURN(0);
  617.  
  618.  /* use 'QUERY EXISTS' with root dirs */
  619.  IF (RIGHT(DirName, 2) = ':\') THEN
  620.    RETURN(STREAM(Dirname, 'C', 'QUERY EXISTS') \= '');
  621.  
  622.  /* query all others */
  623.  IF ((STREAM(Dirname, 'C', 'QUERY EXISTS') = '') &,
  624.      (STREAM(Dirname, 'C', 'QUERY DATETIME') \= '')) THEN
  625.     RETURN(1);
  626.  ELSE
  627.     RETURN(0);
  628.  
  629. /* ------------------------------------------------------------------------- */
  630. GetInstDrive: PROCEDURE EXPOSE env
  631.  ARG DirName, EnvVarName
  632.  
  633.  /* Default: OS2-directory -> determines bootdrive */
  634.  IF (DirName = '') THEN DirName = '\OS2';
  635.  
  636.  /* Default: PATH  */
  637.  IF (EnvVarName = '') THEN EnvVarName = 'PATH';
  638.  
  639.  /* get value */
  640.  PathValue = TRANSLATE(VALUE(EnvVarName,,env));
  641.  
  642.  /* search entry and return drive */
  643.  DirName = ':'DirName';';
  644.  EntryPos = POS(DirName, PathValue) - 1;
  645.  IF (EntryPos = -1) THEN
  646.     RETURN('');
  647.  InstDrive = SUBSTR(PathValue, EntryPos, 2);
  648.  RETURN(InstDrive);
  649.  
  650. /* ------------------------------------------------------------------------- */
  651. MakePath: PROCEDURE EXPOSE (GlobalVars)
  652.  PARSE ARG PathName;
  653.  
  654.  PARSE SOURCE . . CallName
  655.  FileName = SUBSTR( CallName, LASTPOS( '\', CallName) + 1);
  656.  'XCOPY' CallName PathName'\' Redirection;
  657.  rcx = SysFileDelete( PathName'\'FileName);
  658.  RETURN( rc);
  659.  
  660. /* ========================================================================= */
  661. SetCVSPath: PROCEDURE EXPOSE (GlobalVars)
  662.  PARSE ARG CvsBinRoot;
  663.  
  664.  rc = ERROR.NO_ERROR;
  665.  
  666.  DO UNTIL (TRUE)
  667.  
  668.     /* - search CVS binaries */
  669.     fCvsFound = (SysSearchPath('PATH', 'CVS.EXE') \= '');
  670.  
  671.     IF (\fCvsFound) THEN
  672.     DO
  673.        IF (CvsBinRoot \= '') THEN
  674.           fCvsFound = FileExist( CvsBinRoot'\bin\cvs.exe');
  675.     END;
  676.  
  677.     IF (\fCvsFound) THEN
  678.     DO
  679.        ErrorMsg = 'CVS binaries could not be found!';
  680.        rc = ERROR.FILE_NOT_FOUND;
  681.        LEAVE;
  682.     END;
  683.  
  684.     /* - extend path to CVS binaries */
  685.     IF (SysSearchPath('PATH', 'CVS.EXE') = '') THEN
  686.     DO
  687.        AddToPath = CvsBinRoot'\bin;';
  688.        CurrentPath = VALUE( 'PATH',,env);
  689.        IF (POS( AddToPath, CurrentPath) = 0) THEN
  690.           rcx = VALUE('PATH', AddToPath''CurrentPath,env);
  691.     END;
  692.  END;
  693.  
  694.  RETURN(rc);
  695.  
  696. /* ========================================================================= */
  697. unixslash: PROCEDURE
  698.  PARSE ARG string
  699.  RETURN(TRANSLATE( string, '/', '\'));
  700.  
  701. /* ========================================================================= */
  702. FileContains: PROCEDURE
  703.  PARSE ARG Text, File;
  704.  
  705.  rc = SysFileSearch( Text, File, 'FoundLine.');
  706.  RETURN((rc = 0) & (FoundLine.0 > 0));
  707.  
  708. /* ========================================================================= */
  709. ClearDirectory: PROCEDURE EXPOSE (GlobalVars);
  710.  
  711.  PARSE ARG DirName;
  712.  
  713.  DO UNTIL (TRUE)
  714.     CALL CHAROUT, '- Deleting contents of' DirName '... ';
  715.  
  716.     /* delete files first */
  717.     rc = SysFileTree( DirName'\*', 'File.', 'OFS', '*****','-----');
  718.     IF (rc \= ERROR.NO_ERROR) THEN
  719.     DO
  720.        rc = ERROR.NOT_ENOUGH_MEMORY;
  721.        LEAVE;
  722.     END;
  723.     DO i = File.0 TO 1 BY -1
  724.        'attrib -r -h -s' File.i Redirection;
  725.        rc = SysFileDelete( File.i);
  726.        IF (rc \= ERROR.NO_ERROR) THEN
  727.           LEAVE;
  728.     END;
  729.     IF (rc \= ERROR.NO_ERROR) THEN
  730.        LEAVE;
  731.  
  732.     /* delete directories then */
  733.     rc = SysFileTree( DirName'\*', 'Dir.', 'ODS', '*****','-----');
  734.     IF (rc \= ERROR.NO_ERROR) THEN
  735.     DO
  736.        rc = ERROR.NOT_ENOUGH_MEMORY;
  737.        LEAVE;
  738.     END;
  739.  
  740.     DO i = Dir.0 TO 1 BY -1
  741.        'RD' Dir.i Redirection;
  742.     END;
  743.  
  744.     /* search any remaining files and directories now */
  745.     rc = SysFileTree( DirName'\*', 'Both.', 'OBS');
  746.     IF (rc \= ERROR.NO_ERROR) THEN
  747.     DO
  748.        rc = ERROR.NOT_ENOUGH_MEMORY;
  749.        LEAVE;
  750.     END;
  751.     IF (Both.0 > 0) THEN
  752.     DO
  753.        rc = ERROR.ACCESS_DENIED;
  754.        LEAVE;
  755.     END;
  756.  
  757.  END;
  758.  
  759.  IF (rc = ERROR.NO_ERROR) THEN
  760.     SAY 'Ok.';
  761.  ELSE
  762.     SAY 'Error !';
  763.  
  764.  RETURN( rc);
  765.  
  766. /* ========================================================================= */
  767. CheckMissingFile: PROCEDURE
  768.  PARSE ARG Filename;
  769.  
  770.  IF (\FileExist( Filename)) THEN
  771.     RETURN( FILESPEC( 'N', Filename));
  772.  ELSE
  773.     RETURN('');
  774.  
  775. /* ========================================================================= */
  776. SetupCVSService: PROCEDURE EXPOSE (GlobalVars);
  777.  PARSE ARG CvsArchiveRoot, CvsExe, Hostname;
  778.  
  779.  /* defaults */
  780.  fChanged = FALSE;
  781.  rc = ERROR.NO_ERROR;
  782.  
  783.  DO UNTIL (TRUE)
  784.  
  785.     /* get some values */
  786.     EtcDir = VALUE( 'ETC',,env);
  787.     IF (EtcDir = '') THEN
  788.     DO
  789.        SAY 'etc variable not set.';
  790.        rc = ERROR.ENVVAR_NOT_FOUND;
  791.        LEAVE;
  792.     END;
  793.     TmpDir = VALUE( 'TMP',,env);
  794.     IF (TmpDir = '') THEN
  795.     DO
  796.        SAY 'tmp variable not set.';
  797.        rc = ERROR.ENVVAR_NOT_FOUND;
  798.        LEAVE;
  799.     END;
  800.  
  801.     InetdListFile  = EtcDir'\inetd.lst';
  802.     ServicesFile   = EtcDir'\services';
  803.     TcpStartFile   = SysSearchPath( 'PATH', 'tcpstart.cmd');
  804.     ServiceProgram = CallDir'\cvsservice.cmd';
  805.     ArchiveList    = CallDir'\archives.lst';
  806.     PrivateList    = CallDir'\private.lst';
  807.  
  808.     /* rewrite service program */
  809.     Filename = CvsArchiveRoot'\CVSROOT';
  810.     Options  = 'ODS';
  811.     rc = SysFileTree( FileName, 'ArchiveDir.', Options);
  812.     IF (rc \= ERROR.NO_ERROR) THEN
  813.     DO
  814.        ErrorMsg = 'Error in SysFileTree: not enough memory.';
  815.        rc = ERROR.NOT_ENOUGH_MEMORY;
  816.        LEAVE;
  817.     END;
  818.     MaxNameLen = 0;
  819.     DO i = 1 TO ArchiveDir.0
  820.        PathWords = TRANSLATE( ArchiveDir.i, ' ', '\');
  821.        ArchiveDir.i = WORD( PathWords, WORDS( PathWords) - 1);
  822.        MaxNameLen = MAX( MaxNameLen, LENGTH(ArchiveDir.i));
  823.     END;
  824.  
  825.     rcx = SysFileDelete( ServiceProgram);
  826.     IF (ArchiveDir.0 = 0) THEN
  827.        SAY '- skipping creation of service program: no archives present.'
  828.     ELSE
  829.     DO
  830.        CALL CHAROUT, 'Writing service program ... ';
  831.        TextLen = LENGTH( Title);
  832.        rcx = LINEOUT( ServiceProgram, ':' LEFT( 'cvsservice program generated at' DATE('E') TIME(), TextLen));
  833.        rcx = LINEOUT( ServiceProgram, ':' Title);
  834.        rcx = CHAROUT( ServiceProgram, '@call' CvsExe);
  835.        AllowRoots = '';
  836.        DO i = 1 TO ArchiveDir.0
  837.           rcx = CHAROUT(ServiceProgram, ' --allow-root='unixslash(CvsArchiveRoot'\'ArchiveDir.i));
  838.        END;
  839.        rcx = LINEOUT( ServiceProgram, ' pserver %1');
  840.        rcx = STREAM( ServiceProgram, 'C', 'CLOSE');
  841.        SAY 'Ok.';
  842.     END;
  843.  
  844.     /* write all archives to archive list file */
  845.     /* take care for private archives though   */
  846.     PrivateArchives = '';
  847.     PublicArchives  = '';
  848.     rcx = SysFileDelete( ArchiveList);
  849.     rcx = SysFileDelete( PrivateList);
  850.     IF (ArchiveDir.0 = 0) THEN
  851.        SAY '- skipping creation of archive list files: no archives present.'
  852.     ELSE
  853.     DO
  854.        CALL CHAROUT, 'Writing archive list files ... ';
  855.        RootMaxLen = LENGTH( Hostname)      + 1 +,
  856.                     LENGTH(CvsArchiveRoot) + 1 +,
  857.                     MaxNameLen             + 1;
  858.  
  859.        rcx = SysFileDelete( ArchiveList);
  860.        DO i = 1 TO ArchiveDir.0
  861.           ThisCvsRoot = Hostname':'unixslash(CvsArchiveRoot'\'ArchiveDir.i);
  862.           SELECT
  863.              WHEN (IsArchivePrivate( ArchiveDir.i, CvsArchiveRoot)) THEN
  864.              DO
  865.                 OutFile = PrivateList;
  866.                 PrivateArchives = PrivateArchives ArchiveDir.i;
  867.              END;
  868.              OTHERWISE
  869.              DO
  870.                 OutFile = ArchiveList;
  871.                 PublicArchives = PublicArchives ArchiveDir.i;
  872.              END;
  873.           END;
  874.           rcx = LINEOUT(OutFile, LEFT( ThisCvsRoot, RootMaxLen) GetArchiveComment( ArchiveDir.i, CvsArchiveRoot));
  875.        END;
  876.        rcx = STREAM( ArchiveList, 'C', 'CLOSE');
  877.        rcx = STREAM( PrivateList, 'C', 'CLOSE');
  878.        SAY 'Ok.';
  879.  
  880.        /* show what is there */
  881.        PublicArchives  = STRIP( PublicArchives);
  882.        PrivateArchives = STRIP( PrivateArchives);
  883.        IF (PublicArchives = '')  THEN PublicArchives  = '-none-';
  884.        IF (PrivateArchives = '') THEN PrivateArchives = '-none-';
  885.        SAY '- public archives:' PublicArchives;
  886.        SAY '- private archives:' PrivateArchives;
  887.     END;
  888.  
  889.     /* all files present ? inetd.lst may not exist */
  890.     CALL CHAROUT, 'Reading TCP/IP configuration ... ';
  891.     MissingFiles =              CheckMissingFile( ServicesFile);
  892.     MissingFiles = MissingFiles CheckMissingFile( TcpStartFile);
  893.     IF (MissingFiles \= '') THEN
  894.     DO
  895.        SAY 'Error !';
  896.        SAY;
  897.        SAY 'The following file(s) of the TCP/IP configuration are missing:';
  898.        SAY '   ' MissingFiles;
  899.        SAY;
  900.        rc = ERROR.FILE_NOT_FOUND;
  901.        LEAVE;
  902.     END;
  903.  
  904.     SAY 'Ok.';
  905.  
  906.     /* - services */
  907.     CvsServiceName = 'cvspserver';
  908.     fAddService    = TRUE;
  909.  
  910.     rc = SysFileSearch( CvsServiceName, ServicesFile, 'FoundLine.');
  911.     IF (FoundLine.0 > 0) THEN
  912.     DO
  913.        DO i = 1 TO FoundLine.0
  914.           PARSE VAR FoundLine.i ServiceName .;
  915.           IF (LEFT( ServiceName, 1) = '#') THEN
  916.              ITERATE;
  917.           IF (ServiceName = CvsServiceName) THEN
  918.           DO
  919.              SAY '- skipping addition of CVS port to services: already included ('CvsServiceName')';
  920.              fAddService    = FALSE;
  921.              LEAVE;
  922.           END;
  923.        END;
  924.     END;
  925.  
  926.     IF (fAddService) THEN
  927.     DO
  928.        CALL CHAROUT, '- adding CVS port ('CvsServiceName') to services ... ';
  929.        rc = SysFileTree( ServicesFile, 'File.', 'FO',,'-----');
  930.        rc = LINEOUT( ServicesFile, '# For CVS service ');
  931.        rc = LINEOUT( ServicesFile, CvsServiceName '     2401/tcp');
  932.        rc = LINEOUT( ServicesFile);
  933.        SAY 'Ok.';
  934.     END;
  935.  
  936.  
  937.     /* - inetd.lst */
  938.     IF ((FileExist(InetdListFile)) &  (FileContains( CvsServiceName, InetdListFile))) THEN
  939.     DO
  940.        SAY '- skipping addition of CVS service to inet daemon list: already included.';
  941.     END;
  942.     ELSE
  943.     DO
  944.        CALL CHAROUT, '- adding CVS service to inet daemon list ... ';
  945.        rc = SysFileTree( InetdListFile, 'File.', 'FO',,'-----');
  946.        rc = LINEOUT( InetdListFile, CvsServiceName 'tcp' ServiceProgram);
  947.        rc = LINEOUT( InetdListFile);
  948.        SAY 'Ok.';
  949.        fChanged = TRUE;
  950.     END;
  951.  
  952.     /* - tcpstart.cmd */
  953.     fAutostarted = FALSE;
  954.     InetdLine = 0;
  955.     rc = SysFileSearch( ' inetd', TcpStartFile, 'FoundLine.', 'N');
  956.     IF (FoundLine.0 > 0) THEN
  957.     DO
  958.        DO i = 1 TO FoundLine.0
  959.           LastWord = TRANSLATE( WORD( FoundLine.i, WORDS( FoundLine.i)));
  960.           IF ( LastWord = 'INETD') THEN
  961.           DO
  962.              InetdLine = WORD( FoundLine.i, 1);
  963.              FirstWord = TRANSLATE( WORD( FoundLine.i, 2)); /* number at begin ! */
  964.              IF (WORDPOS( FirstWord, 'REM DETACH :') = 0) THEN
  965.              DO
  966.                 fAutostarted = TRUE;
  967.                 LEAVE;
  968.              END;
  969.           END;
  970.        END;
  971.     END;
  972.     IF (fAutostarted) THEN
  973.        SAY '- skipping to set internet super daemon to autostart: already autostarted.';
  974.     ELSE
  975.     DO
  976.        CALL CHAROUT, '- set internet super daemon to autostart ... ';
  977.  
  978.        /* read lines and remove the appropriate REMs */
  979.        TcpStartFileTmp = SysTempFileName( TmpDir'\tcpstart.???');
  980.        LineCount = 1;
  981.        DO WHILE (LINES(TcpStartFile) > 0)
  982.           ThisLine = LINEIN( TcpStartFile);
  983.           IF ((LineCount = InetdLine) | (LineCount = InetdLine + 1)) THEN
  984.           DO
  985.  
  986.              FirstWord = TRANSLATE( WORD( ThisLine, 1));
  987.              IF (WORDPOS( FirstWord, 'REM DETACH :') > 0) THEN
  988.              DO
  989.                 /* remove remark */
  990.                 IF (FirstWord \= 'DETACH') THEN
  991.                    ThisLine = DELWORD( ThisLine, 1, 1);
  992.  
  993.                 /* check for start command: add /min parm */
  994.                 FirstWord = TRANSLATE( WORD( ThisLine, 1));
  995.                 fMinimized = (POS( '/MIN', TRANSLATE(ThisLine)) > 0);
  996.                 SELECT
  997.                    WHEN ((FirstWord = 'START') & (\fMinimized)) THEN
  998.                       ThisLine = INSERT( '/min ', ThisLine, WORDINDEX( ThisLine, 2) - 1);
  999.  
  1000.                    WHEN (FirstWord = 'DETACH') THEN
  1001.                    DO
  1002.                       ThisLine = 'start /min' DELWORD( ThisLine, 1, 1);
  1003.                    END;
  1004.  
  1005.                    OTHERWISE NOP;
  1006.                 END;
  1007.  
  1008.              /* reduce spaces */
  1009.              ThisLine = SPACE(ThisLine);
  1010.  
  1011.              END;
  1012.           END;
  1013.           rcx   = LINEOUT( TcpStartFileTmp, ThisLine);
  1014.           LineCount = LineCount + 1;
  1015.        END;
  1016.        rc = STREAM( TcpStartFile, 'C', 'CLOSE');
  1017.        rc = STREAM( TcpStartFileTmp, 'C', 'CLOSE');
  1018.  
  1019.        /* copy the new file onto the original */
  1020.        rc = SysFileTree( TcpStartFile, 'File.', 'FO',,'-----');
  1021.        'COPY' TcpStartFileTmp TcpStartFile Redirection;
  1022.        rc = SysFileDelete( TcpStartFileTmp);
  1023.        SAY 'Ok.';
  1024.  
  1025.        fChanged = TRUE;
  1026.     END;
  1027.  END;
  1028.  
  1029.  IF (fChanged) THEN
  1030.  DO
  1031.     SAY ;
  1032.     SAY 'The TCP/IP configuration has been changed';
  1033.     SAY 'In order to (re)activate the CVS service'
  1034.     SAY 'please stop the inetd session (if running)'
  1035.     SAY 'and execute the following command:';
  1036.     SAY '   tcpstart';
  1037.  END;
  1038.  
  1039.  SAY;
  1040.  RETURN( rc);
  1041.  
  1042. /* ========================================================================= */
  1043. CreateSnapshot: PROCEDURE EXPOSE (GlobalVars);
  1044.  PARSE ARG Archive, CvsSnapshotRoot, RevisionName;
  1045.  
  1046.  /* defaults */
  1047.  rc = SETLOCAL();
  1048.  fChanged = FALSE;
  1049.  rc = ERROR.NO_ERROR;
  1050.  CurrentDir = DIRECTORY();
  1051.  
  1052.  DO UNTIL (TRUE)
  1053.  
  1054.  
  1055.     /* get some values */
  1056.     TmpDir = VALUE( 'TMP',,env);
  1057.     IF (TmpDir = '') THEN
  1058.     DO
  1059.        SAY 'tmp variable not set.';
  1060.        rc = ERROR.ENVVAR_NOT_FOUND;
  1061.     END;
  1062.  
  1063.     /* create temp dir */
  1064.     CvsTmpDir = SysTempFileName( TmpDir'\snapshot.???');
  1065.     'MD' CvsTmpDir Redirection;
  1066.     IF (rc \= ERROR.NO_ERROR) THEN
  1067.     DO
  1068.        SAY 'Cannot create temporary directory.';
  1069.        LEAVE;
  1070.     END;
  1071.  
  1072.     /* change to it */
  1073.     rcx = DIRECTORY( CvsTmpDir);
  1074.  
  1075.     /* setup snapshot directory */
  1076.     'MD' CvsSnapshotRoot'\'Archive Redirection;
  1077.     LogFile = CvsSnapshotRoot'\'Archive'\'Archive'_'DATE('S')'.log';
  1078.     ZipName = CvsSnapshotRoot'\'Archive'\'Archive'_'DATE('S')'.zip';
  1079.     IF (FileExist( LogFile)) THEN rc = SysFileDelete( LogFile);
  1080.     IF (FileExist( ZipName)) THEN rc = SysFileDelete( ZipName);
  1081.  
  1082.     CALL CHAROUT, 'Checking out to temporary directory ...';
  1083.     IF (RevisionName = '') THEN
  1084.        'cvs co . >' LogFile '2>&1';
  1085.     ELSE
  1086.        'cvs co -r' RevisionName '. >' LogFile '2>&1';
  1087.  
  1088.     IF (rc \= ERROR.NO_ERROR) THEN
  1089.     DO
  1090.        SAY 'Error !';
  1091.        SAY 'See' LogName 'for details';
  1092.        LEAVE;
  1093.     END;
  1094.     ELSE
  1095.        SAY 'Ok.';
  1096.  
  1097.     /* creating zip file  */
  1098.     CALL CHAROUT, 'Creating zip file' ZipName '... ';
  1099.     'SET ZIP=';
  1100.     'zip -m -r -D' ZipName '* -x checkout.log >>' LogFile '2>&1';
  1101.     IF (rc \= ERROR.NO_ERROR) THEN
  1102.     DO
  1103.        SAY ' Error !';
  1104.        SAY 'See' LogName 'for details';
  1105.     END;
  1106.     ELSE
  1107.        SAY ' Ok.';
  1108.  
  1109.     /* reset directory and remove tmp dir */
  1110.     rcx = rc;
  1111.     rc = DIRECTORY( '..');
  1112.     'RD' CvsTmpDir Redirection;
  1113.     rc = rcx;
  1114.  
  1115.     rcx = DIRECTORY( CurrentDir);
  1116.  
  1117.  END;
  1118.  
  1119.  /* cleanup */
  1120.  rcx = DIRECTORY( CurrentDir);
  1121.  RETURN( rc);
  1122.  
  1123. /* ========================================================================= */
  1124. CreateBackup: PROCEDURE EXPOSE (GlobalVars);
  1125.  PARSE ARG Archive, CvsBackupRoot, CvsArchiveRoot;
  1126.  
  1127.  /* defaults */
  1128.  rc = SETLOCAL();
  1129.  fChanged = FALSE;
  1130.  rc = ERROR.NO_ERROR;
  1131.  CurrentDir = DIRECTORY();
  1132.  
  1133.  DO UNTIL (TRUE)
  1134.  
  1135.     /* setup snapshot directory */
  1136.     'MD' CvsBackupRoot'\'Archive Redirection;
  1137.     Timestamp = DATE('S')''TRANSLATE('abcdef', TIME(), 'ab:cd:ef');
  1138.     ZipName = CvsBackupRoot'\'Archive'\'TimeStamp'.zip';
  1139.     IF (FileExist( ZipName)) THEN rc = SysFileDelete( ZipName);
  1140.  
  1141.     /* creating zip file  */
  1142.     CALL CHAROUT, 'Creating zip file' ZipName '...';
  1143.     'SET ZIP=';
  1144.     'zip -r' ZipName CvsArchiveRoot'\'Archive'\*' Redirection;
  1145.     IF (rc \= ERROR.NO_ERROR) THEN
  1146.     DO
  1147.        SAY 'Error creating zip file' ZipName '!';
  1148.     END;
  1149.     ELSE
  1150.     DO
  1151.        SAY ' Ok.';
  1152.        SAY;
  1153.        SAY 'Created zip file:';
  1154.        'DIR' ZipName;
  1155.     END;
  1156.  
  1157.  END;
  1158.  
  1159.  RETURN( rc);
  1160.  
  1161. /* ========================================================================= */
  1162. SecureArchive: PROCEDURE EXPOSE (GlobalVars);
  1163.  PARSE ARG Archive, CvsArchiveRoot, CvsWorkRoot, CvsUser;
  1164.  
  1165.  /* defaults */
  1166.  rc = SETLOCAL();
  1167.  fChanged = FALSE;
  1168.  rc = ERROR.NO_ERROR;
  1169.  CurrentDir = DIRECTORY();
  1170.  
  1171.  SAY;
  1172.  DO UNTIL (TRUE)
  1173.  
  1174.     /* is security script available ? */
  1175.     CvsSecureScript = CallDir'\cvssec.cmd';
  1176.     IF (\FileExist(CvsSecureScript)) THEN
  1177.     DO
  1178.        ErrorMsg = 'Security script' CvsSecureScript 'not found.';
  1179.        rc = ERROR.FILE_NOT_FOUND;
  1180.        LEAVE;
  1181.     END;
  1182.  
  1183.     /* is archive initialized ? */
  1184.     CvsDbDir = CvsArchiveRoot'\'Archive'\CVSROOT';
  1185.     IF (\FileExist( CvsDbDir'\*')) THEN
  1186.     DO
  1187.        ErrorMsg = 'Archive not yet initialized.'
  1188.        rc = ERROR.INVALID_FUNCTION;
  1189.        LEAVE;
  1190.     END;
  1191.  
  1192.     PasswdFile = CallDir'\passwd';
  1193.     IF (\FileExist( PasswdFile)) THEN
  1194.     DO
  1195.        /* ask for password */
  1196.        SAY;
  1197.  
  1198.        DO WHILE (TRUE)
  1199.           CvsPassword1 = STRIP( PullVariable( ,            'Enter the password for' CvsUser));
  1200.           CvsPassword2 = STRIP( PullVariable( ,            'Enter the password for' CvsUser 'AGAIN'));
  1201.  
  1202.           IF (CvsUser = '') THEN
  1203.           DO
  1204.              SAY;
  1205.              SAY 'user not specified. Please try again.'
  1206.              ITERATE;
  1207.           END;
  1208.  
  1209.           IF (CvsPassword1 \= CvsPassword2) THEN
  1210.           DO
  1211.              SAY;
  1212.              SAY 'passwords are different. Please try again.'
  1213.              ITERATE;
  1214.           END;
  1215.  
  1216.           SAY;
  1217.           LEAVE;
  1218.        END;
  1219.  
  1220.        /* create password file */
  1221.        rc = DIRECTORY( CallDir);
  1222.        CALL CHAROUT, '- Creating passwd file ...';
  1223.        'CALL CVSPW -add' CvsUser CvsPassword1 Redirection;
  1224.        IF (rc \= ERROR.NO_ERROR) THEN
  1225.        DO
  1226.           ErrorMsg = 'Cannot setup password file.';
  1227.           LEAVE;
  1228.        END;
  1229.        'CALL CVSPW -add ' GuestAccount Redirection;
  1230.        SAY ' Ok.';
  1231.     END;
  1232.  
  1233.     /* copy the passwd file to the new archive directory */
  1234.     CALL CHAROUT, '- Copying current passwd file to archive CVSROOT ...';
  1235.     'COPY' PasswdFile CvsDbDir Redirection;
  1236.     IF (rc = ERROR.NO_ERROR) THEN
  1237.        SAY ' Ok.';
  1238.     ELSE
  1239.     DO
  1240.        ErrorMsg = 'Cannot copy passwd file.';
  1241.        LEAVE;
  1242.     END;
  1243.  
  1244.     /* checking some files */
  1245.     WorkingDir = CvsWorkRoot'\'Archive;
  1246.     rc = DIRECTORY(WorkingDir);
  1247.     CALL CHAROUT, '- Retrieving current CVSROOT ...';
  1248.     'cvs co CVSROOT' Redirection;
  1249.     IF (rc \= ERROR.NO_ERROR) THEN
  1250.     DO
  1251.        ErrorMsg = 'Cannot retrieve CVSROOT.';
  1252.        LEAVE;
  1253.     END;
  1254.     ELSE
  1255.        SAY ' Ok.';
  1256.  
  1257.     /* check file contents */
  1258.     WorkingDbDir = WorkingDir'\CVSROOT';
  1259.  
  1260.     /* - checkout list */
  1261.     FileCheckoutList = WorkingDbDir'\checkoutlist';
  1262.     IF (FileContains( 'writeinfo', FileCheckoutList)) THEN
  1263.        SAY '- skipping addition of writeinfo to checkoutlist: already included.';
  1264.     ELSE
  1265.     DO
  1266.        CALL CHAROUT, '- adding writeinfo to checkoutlist ...';
  1267.        rc = SysFileTree( FileCheckoutList, 'File.', 'FO',,'-----');
  1268.        rc = LINEOUT( FileCheckoutList, 'writeinfo Cannot checkout writeinfo !');
  1269.        rc = LINEOUT( FileCheckoutList);
  1270.        SAY ' Ok.';
  1271.        fChanged = TRUE;
  1272.     END;
  1273.  
  1274.     /* - writers */
  1275.     FileWriters = WorkingDbDir'\writers';
  1276.     IF (FileExist(FileWriters)) THEN
  1277.        SAY '- skipping creation of file writers: already exists.';
  1278.     ELSE
  1279.     DO
  1280.        CALL CHAROUT, '- creating writers ...';
  1281.        rc = LINEOUT( FileWriters, CvsUser);
  1282.        rc = LINEOUT( FileWriters);
  1283.        'cvs add' FileWriters Redirection;
  1284.        SAY ' Ok.';
  1285.        fChanged = TRUE;
  1286.     END;
  1287.  
  1288.     /* - commitinfo */
  1289.     FileCommitinfo = WorkingDbDir'\commitinfo';
  1290.     IF (FileContains( 'cvssec.cmd', FileCommitinfo)) THEN
  1291.        SAY '- skipping addition of cvssec.cmd to commitinfo: already included.';
  1292.     ELSE
  1293.     DO
  1294.        CALL CHAROUT, '- adding security program to commitinfo ...';
  1295.        rc = SysFileTree( FileCommitinfo, 'File.', 'FO',,'-----');
  1296.        rc = LINEOUT( FileCommitinfo, 'ALL' CvsSecureScript 'CHECKCOMMIT');
  1297.        rc = LINEOUT( FileCommitinfo);
  1298.        SAY ' Ok.';
  1299.        fChanged = TRUE;
  1300.     END;
  1301.  
  1302.     /* - taginfo */
  1303.     FileTaginfo = WorkingDbDir'\taginfo';
  1304.     IF (FileContains( 'cvssec.cmd', FileTaginfo)) THEN
  1305.        SAY '- skipping addition of cvssec.cmd to taginfo: already included.';
  1306.     ELSE
  1307.     DO
  1308.        CALL CHAROUT, '- adding security program to taginfo ...';
  1309.        rc = SysFileTree( FileTaginfo, 'File.', 'FO',,'-----');
  1310.        rc = LINEOUT( FileTaginfo, 'ALL' CvsSecureScript 'CHECKTAG');
  1311.        rc = LINEOUT( FileTaginfo);
  1312.        SAY ' Ok.';
  1313.        fChanged = TRUE;
  1314.     END;
  1315.  
  1316.     /* - writeinfo */
  1317.     FileWriteinfo = WorkingDbDir'\writeinfo';
  1318.     IF (FileExist( FileWriteinfo)) THEN
  1319.        SAY '- skipping creation of writeinfo: already exists.';
  1320.     ELSE
  1321.     DO
  1322.        CALL CHAROUT, '- creating writeinfo ...';
  1323.        BaseDir = CvsArchiveRoot'\'Archive;
  1324.        rc = SysFileTree( CvsArchiveRoot'\'Archive'\*', 'Subdir.', 'ODS');
  1325.        IF (rc \= ERROR.NO_ERROR) THEN
  1326.        DO
  1327.           ErrorMsg = 'Error in SysFileTree.';
  1328.           LEAVE;
  1329.        END;
  1330.  
  1331.        /* check maxlen of directory */
  1332.        MaxLen = 0;
  1333.        DO i = 1 TO Subdir.0
  1334.           MaxLen = MAX( MaxLen, LENGTH( Subdir.i));
  1335.        END;
  1336.  
  1337.        /* start with basic directory */
  1338.        rc = LINEOUT( FileWriteinfo, LEFT( '/', MaxLen) '*');
  1339.        rc = LINEOUT( FileWriteinfo, LEFT( '/CVSROOT', MaxLen) CvsUser);
  1340.  
  1341.        /* add all other except CVS directories */
  1342.        DO i = 1 TO Subdir.0
  1343.           IF ((POS( '\CVS\', Subdir.i) = 0) &,
  1344.               (POS( '\CVSROOT', Subdir.i) = 0)) THEN
  1345.           DO
  1346.              ThisDir = DELSTR( Subdir.i, 1, LENGTH(BaseDir));
  1347.              ThisDir = TRANSLATE( ThisDir, '/', '\');
  1348.              rc = LINEOUT( FileWriteinfo, LEFT( ThisDir, MaxLen) '*');
  1349.           END;
  1350.        END;
  1351.        'cvs add' FileWriteinfo Redirection;
  1352.        SAY ' Ok.';
  1353.        fChanged = TRUE;
  1354.  
  1355.     END;
  1356.  
  1357.     /* turn on writeinfo logging */
  1358.     LogFile = CvsArchiveRoot'\'Archive'\CVSROOT\writeinfo.log';
  1359.     IF (FileExist( LogFile)) THEN
  1360.        SAY '- skipping activation of writeinfo log: already activated.';
  1361.     ELSE
  1362.     DO
  1363.        CALL CHAROUT, '- activating writeinfo log ...';
  1364.        rc= LINEOUT( LogFile);
  1365.        SAY ' Ok.';
  1366.     END;
  1367.  
  1368.     /* commit the changes */
  1369.     IF (fChanged) THEN
  1370.     DO
  1371.        CALL CHAROUT, '- commiting changes to archive ...';
  1372.        'CALL cvs commit -m "cvssenv: Added security" CVSROOT' Redirection;
  1373.        IF (rc = ERROR.NO_ERROR) THEN
  1374.           SAY ' Ok.'
  1375.        ELSE
  1376.           SAY ' Error !';
  1377.     END;
  1378.  
  1379.  END;
  1380.  
  1381.  RETURN( rc);
  1382.  
  1383. /* ========================================================================= */
  1384. InitializeArchive: PROCEDURE EXPOSE (GlobalVars);
  1385.  PARSE ARG Archive, CvsArchiveRoot, CvsWorkRoot, ArchiveComment;
  1386.  
  1387.  /* defaults */
  1388.  rc = ERROR.NO_ERROR;
  1389.  
  1390.  SAY;
  1391.  DO UNTIL (TRUE)
  1392.  
  1393.     TmpDir = VALUE( 'TMP',,env);
  1394.     IF (TmpDir = '') THEN
  1395.     DO
  1396.        SAY 'tmp variable not set.';
  1397.        rc = ERROR.ENVVAR_NOT_FOUND;
  1398.        LEAVE;
  1399.     END;
  1400.  
  1401.  
  1402.     /* create archive directory */
  1403.     ArchiveDir = CvsArchiveRoot'\'Archive;
  1404.     IF (\DirExist( ArchiveDir)) THEN
  1405.     DO
  1406.        rc = CreateArchiveDir( ArchiveDir, 'archive directory');
  1407.        IF (rc \= ERROR.NO_ERROR) THEN
  1408.           LEAVE;
  1409.     END;
  1410.  
  1411.     /* create working dir for local access */
  1412.     WorkingDir = CvsWorkRoot'\'Archive;
  1413.     IF ((CvsWorkRoot \= '') & (\DirExist(WorkingDir))) THEN
  1414.     DO
  1415.        rc = CreateArchiveDir( WorkingDir, 'working directory');
  1416.        IF (rc \= ERROR.NO_ERROR) THEN
  1417.           LEAVE;
  1418.     END;
  1419.     rcx = DIRECTORY( WorkingDir);
  1420.  
  1421.     /* initialize CVS archive */
  1422.     LogFile = SysTempFileName( TmpDir'\cvsenv.???');
  1423.     CALL CHAROUT, '- Initializing archive directory for archive' Archive '... ';
  1424.     'CALL cvs init >' LogFile;
  1425.     IF (rc = ERROR.NO_ERROR) THEN
  1426.        SAY 'Ok.';
  1427.     ELSE
  1428.     DO
  1429.        SAY 'Error!';
  1430.        'TYPE' LogFile;
  1431.     END;
  1432.     rcx = SysFileDelete( LogFile);
  1433.     IF (rc \= ERROR.NO_ERROR) THEN
  1434.        LEAVE;
  1435.     /* wait for CVS (or filesystem ?) to write files */
  1436.     rcx = SysSleep( 1)
  1437.  
  1438.     /* prompt for archive comment */
  1439.     rcx = EditArchiveComment( Archive, CvsArchiveRoot, ArchiveComment);
  1440.  
  1441.     /* change to working dir */
  1442.     CALL CHAROUT, '- Adding wrappers for binary files ... ';
  1443.     WrapperFile = 'cvswrappers';
  1444.     'CALL cvs co .' Redirection;
  1445.     'TYPE' CallDir'\samples\'WrapperFile' > CVSROOT\'WrapperFile;
  1446.     'CALL cvs commit -m "cvssenv: Added cvswrappers for binary files" CVSROOT\'WrapperFile Redirection;
  1447.     IF (rc = ERROR.NO_ERROR) THEN
  1448.        SAY 'Ok.';
  1449.     ELSE
  1450.        SAY 'Error!';
  1451.  
  1452.  
  1453.  END;
  1454.  
  1455.  RETURN( rc);
  1456.  
  1457. /* ========================================================================= */
  1458. ImportArchive: PROCEDURE EXPOSE (GlobalVars);
  1459.  PARSE ARG Archive, ZipName, CvsArchiveRoot, CvsWorkRoot;
  1460.  
  1461.  /* defaults */
  1462.  rc = ERROR.NO_ERROR;
  1463.  
  1464.  SAY;
  1465.  DO UNTIL (TRUE)
  1466.  
  1467.     ImportTitle  = 'Import archive file' Zipname 'for archive' Archive':';
  1468.     SAY;
  1469.     SAY ImportTitle;
  1470.     SAY COPIES( '-', LENGTH( ImportTitle));
  1471.  
  1472.     /* .............................................................. */
  1473.  
  1474.     /* unzip the file to create teh directory structure */
  1475.     CALL CHAROUT, 'Create directory tree ... ';
  1476.     'CALL UNZIP' ZipName '-x' UnzipExclude Redirection;
  1477.     IF (rc \= ERROR.NO_ERROR) THEN
  1478.     DO
  1479.        ErrorMsg = 'The zip file' ZipName 'could not be unpacked properly.';
  1480.        rc = ERROR.INVALID_DATA;
  1481.     END;
  1482.  
  1483.     /* files are not needed now */
  1484.     rc = SysFileTree( '*', 'File.', 'OFS',,'-----');
  1485.     IF (rc \= ERROR.NO_ERROR) THEN
  1486.     DO
  1487.        ErrorMsg = 'Fehler in SysFileTree.';
  1488.        rc = ERROR.INVALID_FUNCTION;
  1489.        LEAVE;
  1490.     END;
  1491.     DO i = 1 TO File.0
  1492.        rc = SysFileDelete( File.i);
  1493.     END;
  1494.     SAY 'Ok.';
  1495.  
  1496.     /* .............................................................. */
  1497.  
  1498.     /* determine new directories */
  1499.     CALL CHAROUT, 'Import directory tree ... ';
  1500.     rc = SysFileTree( '*', 'File.', 'OD',,'-----');
  1501.     IF (rc \= ERROR.NO_ERROR) THEN
  1502.     DO
  1503.        ErrorMsg = 'Error in SysFileTree.';
  1504.        rc = ERROR.INVALID_FUNCTION;
  1505.        LEAVE;
  1506.     END;
  1507.  
  1508.     /* import all directories straight below CVSROOT */
  1509.     /* subdirectories are included that way */
  1510.     CurrentDir = DIRECTORY();
  1511.     DO i = 1 TO File.0
  1512.        DirNamePos = LASTPOS('\', File.i);
  1513.        rcx = DIRECTORY( File.i);
  1514.        DirName = SUBSTR( File.i, DirNamePos + 1);
  1515.        'CALL cvs import -m "Import of directory tree"' DirName 'netlabs start' Redirection;
  1516.     END;
  1517.     rcx = DIRECTORY( CurrentDir);
  1518.  
  1519.     /* delete the tree again ... */
  1520.     rc = SysFileTree( '*', 'File.', 'ODS',,'-----');
  1521.     IF (rc \= ERROR.NO_ERROR) THEN
  1522.     DO
  1523.        ErrorMsg = 'Error in SysFileTree.';
  1524.        rc = ERROR.INVALID_FUNCTION;
  1525.        LEAVE;
  1526.     END;
  1527.     DO i = File.0 to 1 BY -1
  1528.        'rd' File.i Redirection;
  1529.     END;
  1530.     SAY 'Ok.';
  1531.  
  1532.     /* ... to check it out. */
  1533.     /* Sometimes the checkout does not work */
  1534.     /* properly if something exists before  */
  1535.     CALL CHAROUT, 'Check out directory tree ... ';
  1536.     'CALL cvs co .' Redirection;
  1537.     SAY 'Ok.';
  1538.  
  1539.     /* .............................................................. */
  1540.  
  1541.     /* unzip files again */
  1542.     CALL CHAROUT, 'Unpack source files ... ';
  1543.     'CALL UNZIP -o ' ZipName '-x' UnzipExclude Redirection;
  1544.     IF (rc \= ERROR.NO_ERROR) THEN
  1545.     DO
  1546.        ErrorMsg = 'The zip file' ZipName 'could not be unpacked properly.';
  1547.        rc = ERROR.INVALID_DATA;
  1548.     END;
  1549.  
  1550.     /* search the files */
  1551.     rc = SysFileTree( '*', 'File.', 'OFS',,'-----');
  1552.     IF (rc \= ERROR.NO_ERROR) THEN
  1553.     DO
  1554.        ErrorMsg = 'Error in SysFileTree.';
  1555.        rc = ERROR.INVALID_FUNCTION;
  1556.     END;
  1557.     SAY 'Ok.';
  1558.     SAY;
  1559.  
  1560.     DO i = 1 TO File.0
  1561.  
  1562.        /* ignore CVS management directories */
  1563.        IF (POS( '\CVS', File.i) \= 0) THEN
  1564.           ITERATE;
  1565.  
  1566.        /* assemble some values */
  1567.        FileType       = TypeAscii;
  1568.        FileName       = File.i;
  1569.        FileNamePart   = FILESPEC('N', File.i);
  1570.        FileNameExtPos = LASTPOS( '.', FileNamePart);
  1571.  
  1572.        /* check if file is already in archive */
  1573.        'CALL cvs log' File.i Redirection;
  1574.        IF (rc = 0) THEN
  1575.        DO
  1576.           SAY FileNamePart 'skipped, already in archive.';
  1577.           ITERATE;
  1578.        END;
  1579.  
  1580.        /* determine default file type for extension */
  1581.        IF (FileNameExtPos > 0) THEN
  1582.        DO
  1583.           FileNameExt = TRANSLATE( SUBSTR( FileNamePart, FileNameExtPos));
  1584.           IF (FileNameExt \= '') THEN
  1585.              FileType    = (WORDPOS( FileNameExt, BinFileTypes) > 0);
  1586.        END;
  1587.        ELSE
  1588.           FileNameExt    = '';
  1589.  
  1590.        /* prepare to add a keyword commenline with $Id$ */
  1591.        /* get comment char for this file type */
  1592.        CommentChar    = '';
  1593.        CommentCharEnd = '';
  1594.        FileNameExt = LOWER(FileNameExt); /* convert to lower case like they are stored in OS2.INI */
  1595.  
  1596.        SELECT
  1597.           /* special case: "makefile " */
  1598.           WHEN (TRANSLATE( FileNamePart) = 'MAKEFILE') THEN CommentChar = '#';
  1599.  
  1600.           /* special case: no extension */
  1601.           WHEN (FileNameExt = '')                  THEN NOP;
  1602.  
  1603.           /* special case: CMD: is it a rexx script ? */
  1604.           WHEN (FileNameExt = '.cmd') THEN
  1605.           DO
  1606.              FileSig = CHARIN( FileName, 1, 2);
  1607.              rcx = STREAM( FileName, 'C', 'CLOSE');
  1608.              IF ( FileSig = '/*') THEN
  1609.              DO
  1610.                 CommentChar    = '/*';
  1611.                 CommentCharEnd = '*/';
  1612.              END;
  1613.              ELSE
  1614.              DO
  1615.                 CommentChar = SysIni(, IniAppName_Comment, FileNameExt);
  1616.                 PARSE VAR CommentChar CommentChar"00"x''CommentCharEnd;
  1617.              END;
  1618.           END /* do */
  1619.  
  1620.           /* read from OS2.INI */
  1621.           OTHERWISE
  1622.           DO
  1623.              CommentChar = SysIni(, IniAppName_Comment, FileNameExt);
  1624.              ZeroPos = POS( "00"x, CommentChar);
  1625.              IF (ZeroPos > 0) THEN
  1626.              DO
  1627.                 CommentCharEnd = SUBSTR( CommentChar, ZeroPos + 1);
  1628.                 CommentChar    = LEFT( CommentChar, ZeroPos - 1);
  1629.              END;
  1630.           END;
  1631.        END;
  1632.  
  1633.        IF (CommentChar = 'ERROR:') THEN
  1634.           CommentChar = '';
  1635.  
  1636.        /* does the file already have a keyword line ? */
  1637.        IF (FileType \= TypeBinary) THEN
  1638.        DO
  1639.           IF (CommentChar \= '') THEN
  1640.           DO
  1641.              rcx = SysFileSearch( '$'CvsKeyword, FileName, 'Line.');
  1642.              IF ((rcx = ERROR.NO_ERROR) & (Line.0 > 0)) THEN
  1643.              DO
  1644.                 SAY FileNamePart ': file already contains a keyword line.';
  1645.              END;
  1646.              ELSE
  1647.              DO
  1648.                 Keyword = '$'CvsKeyword'$';
  1649.                 KeywordLine = CommentChar Keyword CommentCharEnd;
  1650.                 SAY FileNamePart ': Insert keyword line: ' KeywordLine;
  1651.  
  1652.                 TmpFile     = FileName'.$$$tmp$$$';
  1653.                 KeywordFile = FileName'.$$$key$$$';
  1654.  
  1655.                 'REN' FileName FILESPEC( 'N', TmpFile);
  1656.                 rc = LINEOUT( KeywordFile, KeywordLine);
  1657.                 rc = LINEOUT( KeywordFile, '');
  1658.                 rc = LINEOUT( KeywordFile);
  1659.                 'COPY' KeywordFile '+' TmpFile FileName Redirection;
  1660.                 'DEL' KeywordFile TmpFile Redirection;
  1661.              END
  1662.           END;
  1663.           ELSE
  1664.              SAY FileNamePart ': No comment character: No keyword line inserted.';
  1665.        END;
  1666.        ELSE
  1667.              SAY FileNamePart ': binary file: No keyword line inserted.';
  1668.  
  1669.        /* add file to archive, disable keyword expansion for binary files */
  1670.        IF (FileType = TypeBinary) THEN
  1671.           KeywordOption = '-kb'
  1672.        ELSE
  1673.           KeywordOption = '';
  1674.        'CALL cvs add' KeywordOption File.i Redirection;
  1675.        IF (rc \= ERROR.NO_ERROR) THEN
  1676.        DO
  1677.           SAY '';
  1678.           SAY 'File' File.i ' could not be added to the archive.';
  1679.           SAY 'Press Ctrl-Break to cancel or';
  1680.           'PAUSE';
  1681.        END;
  1682.  
  1683.     END; /* DO i = 1 TO File.0 */
  1684.  
  1685.     IF (rc \= ERROR.NO_ERROR) THEN
  1686.        LEAVE;
  1687.  
  1688.     /* .............................................................. */
  1689.  
  1690.     /* commit all changes  */
  1691.     SAY;
  1692.     SAY 'About to commit all changes to the archive ...';
  1693.     'PAUSE'
  1694.     'CALL cvs commit -m "Import"'
  1695.  
  1696.     /* .............................................................. */
  1697.     IF (STRIP(CvsBranches) \= '') THEN
  1698.     DO
  1699.        SAY;
  1700.        SAY  'create branches:';
  1701.        /* create branches */
  1702.        DO WHILE ( CvsBranches \= '')
  1703.           PARSE VAR CvsBranches Branch CvsBranches;
  1704.           SAY Branch;
  1705.           'CALL CVS tag -b' Branch '.' Redirection;
  1706.        END;
  1707.        SAY;
  1708.     END;
  1709.  
  1710.  END;
  1711.  
  1712.  RETURN( rc);
  1713.  
  1714. /* ========================================================================= */
  1715. MakeArchivePrivate: PROCEDURE EXPOSE (GlobalVars);
  1716.  PARSE ARG Archive, CvsArchiveRoot, CvsUser;
  1717.  
  1718.  /* defaults */
  1719.  rc = ERROR.NO_ERROR;
  1720.  
  1721.  SAY;
  1722.  DO UNTIL (TRUE)
  1723.  
  1724.     IF (IsArchivePrivate( Archive, CvsArchiveRoot)) THEN
  1725.     DO
  1726.        SAY 'archive' Archive 'is already restricted to private access.';
  1727.        LEAVE;
  1728.     END;
  1729.  
  1730.     ImportTitle  = 'Restrict archive' Archive 'to private access:';
  1731.     SAY;
  1732.     SAY ImportTitle;
  1733.     SAY COPIES( '-', LENGTH( ImportTitle));
  1734.  
  1735.     /* .............................................................. */
  1736.  
  1737.     CALL CHAROUT, 'Creating readers file ...';
  1738.     PasswdFile  = CallDir'\passwd';
  1739.     ReadersFile = 'CVSROOT\readers';
  1740.     rcx = SysFileDelete( ReadersFile);
  1741.     rcx = LINEOUT( ReadersFile, CvsUser);
  1742.     IF (FileExist( PasswdFile)) THEN
  1743.     DO
  1744.        /* add currently defined users */
  1745.        DO WHILE (LINES( PasswdFile) > 0)
  1746.           ThisDef = LINEIN( PasswdFile);
  1747.           PARSE VAR ThisDef ThisUser':'.;
  1748.           IF (ThisUser \= CvsUser) THEN
  1749.              rcx = LINEOUT( ReadersFile, ';'ThisUser);
  1750.        END;
  1751.        rcx = STREAM( PasswdFile, 'C', 'CLOSE');
  1752.     END;
  1753.     rcx = STREAM( ReadersFile, 'C', 'CLOSE');
  1754.     SAY ' Ok.';
  1755.  
  1756.     /* add readers to archive and commit */
  1757.     CALL CHAROUT, 'Adding readers file to archive ...';
  1758.     'cvs add' ReadersFile Redirection;
  1759.     'cvs commit -m "cvssenv: Added readers file"' ReadersFile Redirection;
  1760.     IF (rc \= ERROR.NO_ERROR) THEN
  1761.     DO
  1762.        SAY ' Error !';
  1763.        LEAVE;
  1764.     END;
  1765.     SAY ' Ok.';
  1766.  
  1767.  END;
  1768.  
  1769.  RETURN( rc);
  1770.  
  1771. /* ========================================================================= */
  1772. ListArchives: PROCEDURE EXPOSE (GlobalVars);
  1773.  PARSE ARG CvsArchiveRoot;
  1774.  
  1775.  Archive.0  = 0;
  1776.  NameMaxLen = 12;
  1777.  
  1778.  DO UNTIL (TRUE)
  1779.  
  1780.     /* search all archive base directories */
  1781.     rc = SysFileTree( CvsArchiveRoot'\*', 'Dir.', 'DO');
  1782.     IF (rc \= ERROR.NO_ERROR) THEN
  1783.     DO
  1784.        SAY;
  1785.        SAY CmdName': error in SysfileTree. rc='rc;
  1786.        LEAVE;
  1787.     END;
  1788.  
  1789.     /* get all archives */
  1790.     DO d = 1 TO Dir.0
  1791.        IF (\FileExist( Dir.d'\CVSROOT\*')) THEN
  1792.           ITERATE;
  1793.  
  1794.        /* store archive */
  1795.        a                    = Archive.0 + 1;
  1796.        Archive.0            = a;
  1797.        Archive.a            = FILESPEC( 'N', Dir.d);
  1798.        Archive.a.fIsPrivate = IsArchivePrivate( Archive.a, CvsArchiveRoot);
  1799.        Archive.a.Comment    = GetArchiveComment( Archive.a, CvsArchiveRoot);
  1800.        NameMaxLen = MAX( NameMaxLen, LENGTH( Archive.a));
  1801.     END;
  1802.  
  1803.  
  1804.     IF (Archive.0 = 0) THEN
  1805.        SAY 'no archives present yet.';
  1806.     ELSE
  1807.     DO
  1808.        SAY 'status ' LEFT( 'archive', NameMaxLen) 'comment';
  1809.        SAY '-------' COPIES( '-', NameMaxLen)     '---------------------------';
  1810.        DO a = 1 TO Archive.0
  1811.  
  1812.           IF (Archive.a.fIsPrivate) THEN
  1813.              Status = 'private'
  1814.           ELSE
  1815.              Status = 'public ';
  1816.  
  1817.           SAY Status LEFT( Archive.a, NameMaxLen) Archive.a.Comment;
  1818.        END;
  1819.     END;
  1820.  END;
  1821.  SAY;
  1822.  
  1823.  RETURN( ERROR.NO_ERROR);
  1824.  
  1825. /* ========================================================================= */
  1826. SetArchiveComment: PROCEDURE EXPOSE (GlobalVars);
  1827.  PARSE ARG Archive, CvsArchiveRoot, ArchiveComment;
  1828.  
  1829.  CommentFile = CvsArchiveRoot'\'Archive'\CVSROOT\projectinfo';
  1830.  rcx = SysFileDelete( CommentFile);
  1831.  rc = LINEOUT( CommentFile, ArchiveComment);
  1832.  rcx = STREAM( CommentFile, 'C', 'CLOSE');
  1833.  RETURN( ERROR.NO_ERROR);
  1834.  
  1835. /* ========================================================================= */
  1836. EditArchiveComment: PROCEDURE EXPOSE (GlobalVars);
  1837.  PARSE ARG Archive, CvsArchiveRoot, ArchiveComment;
  1838.  
  1839.  ArchiveComment = STRIP(PullVariable( ArchiveComment, 'Enter the comment for this archive:'));
  1840.  RETURN( SetArchiveComment( Archive, CvsArchiveRoot, ArchiveComment));
  1841.  
  1842. /* ========================================================================= */
  1843. GetArchiveComment: PROCEDURE EXPOSE (GlobalVars);
  1844.  PARSE ARG Archive, CvsArchiveRoot;
  1845.  
  1846.  CommentFile = CvsArchiveRoot'\'Archive'\CVSROOT\projectinfo';
  1847.  ArchiveComment = LINEIN( CommentFile);
  1848.  rcx = STREAM( CommentFile, 'C', 'CLOSE');
  1849.  RETURN( ArchiveComment);
  1850.  
  1851. /* ========================================================================= */
  1852. IsArchivePrivate: PROCEDURE EXPOSE (GlobalVars);
  1853.  PARSE ARG Archive, CvsArchiveRoot;
  1854.  
  1855.  RETURN( FileExist( CvsArchiveRoot'\'Archive'\CVSROOT\readers'));
  1856.  
  1857.