home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / nosac106.zip / cvsenv.cmd next >
OS/2 REXX Batch file  |  2001-12-15  |  25KB  |  881 lines
  1. /*
  2.  *      CVSENV.CMD - NOSA Client - V1.06 C.Langanke for Netlabs 1999,2001
  3.  *
  4.  *     Syntax: cvsenv archive_name [action]
  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 NOSAC
  11.  *     /Fixsnapshot        - fixes CVS management files to allow use
  12.  *                           a snapshot being built on the server side
  13.  *     /List               - show current available archives
  14.  *     /Getlist            - get the current archives list via FTP
  15.  *     /User               - switch the user id
  16.  *     /Modules            - Show the modules of an archive
  17.  *     /Report             - generates a change report form
  18.  */
  19. /* First comment is used as help text */
  20.  
  21.  SIGNAL ON HALT
  22.  TitleLine = STRIP(SUBSTR(SourceLine(2), 3));
  23.  PARSE VAR TitleLine CmdName'.CMD 'Info
  24.  Title     = CmdName Info
  25.  
  26.  env          = 'OS2ENVIRONMENT';
  27.  TRUE         = (1 = 1);
  28.  FALSE        = (0 = 1);
  29.  Redirection  = '> NUL 2>&1';
  30.  CrLf         = "0d0a"x;
  31.  '@ECHO OFF'
  32.  
  33.  /* OS/2 errorcodes */
  34.  ERROR.NO_ERROR           =  0;
  35.  ERROR.INVALID_FUNCTION   =  1;
  36.  ERROR.FILE_NOT_FOUND     =  2;
  37.  ERROR.PATH_NOT_FOUND     =  3;
  38.  ERROR.ACCESS_DENIED      =  5;
  39.  ERROR.NOT_ENOUGH_MEMORY  =  8;
  40.  ERROR.INVALID_FORMAT     = 11;
  41.  ERROR.INVALID_DATA       = 13;
  42.  ERROR.NO_MORE_FILES      = 18;
  43.  ERROR.WRITE_FAULT        = 29;
  44.  ERROR.READ_FAULT         = 30;
  45.  ERROR.GEN_FAILURE        = 31;
  46.  ERROR.INVALID_PARAMETER  = 87;
  47.  ERROR.ENVVAR_NOT_FOUND   = 203;
  48.  
  49.  GlobalVars = 'Title CmdName env TRUE FALSE CrLf Redirection ERROR.';
  50.  SAY;
  51.  
  52.  
  53.  /* load RexxUtil */
  54.  CALL RxFuncAdd    'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs';
  55.  CALL SysLoadFuncs;
  56.  
  57.  /* Defaults */
  58.  GlobalVars     = GlobalVars '';
  59.  Action         = '';
  60.  fFixSnapShot   = FALSE;
  61.  fChangeReport  = FALSE;
  62.  
  63.  ValidSwichChars     = '/-$';
  64.  ValidCvsenvCommands = '!LOGIN !LOGOUT /ADD /LOG /TAG /CHECKOUT /UPDATE /STATUS /COMMIT /REMOVE';
  65.  
  66.  Ftp._User      = 'nosac';
  67.  Ftp._Passwd    = 'getarchiveslist';
  68.  Ftp._File      = 'archives.lst';
  69.  
  70.  CallDir        = GetCalldir();
  71.  ArchiveFile    = CallDir'\archives.lst';
  72.  PrivateFile    = CallDir'\private.lst';
  73.  
  74.  IniAppName     = 'NOSAC';
  75.  
  76.  ArchiveVarname = 'NOSAC_ARCHIVE';
  77.  
  78.  rc = ERROR.NO_ERROR;
  79.  
  80.  /* show help */
  81.  ARG Parm .
  82.  IF ((Parm = '') | (POS('?', Parm) > 0)) THEN
  83.  DO
  84.     rc = SetCVSPath( ReadIniValue(, IniAppName, 'CVS_BINROOT'));
  85.     rc = ShowHelp();
  86.     EXIT(ERROR.INVALID_PARAMETER);
  87.  END;
  88.  
  89.  DO UNTIL (TRUE)
  90.  
  91.     /* -------------------------------------------------------------- */
  92.  
  93.     /* init some messages */
  94.     ShowListTitle    = 'Public Open Source Archives currently available:';
  95.     EmptyListMessage = 'Currently no Open Source Archives. Update your archives list!';
  96.  
  97.     /* -------------------------------------------------------------- */
  98.  
  99.     /* read some vars*/
  100.     CvsServer      = ReadIniValue(, IniAppName, 'CVS_SERVER');
  101.     CvsWorkRoot    = ReadIniValue(, IniAppName, 'CVS_WORKROOT');
  102.     CvsInitCommand = ReadIniValue(, IniAppName, 'CVS_INITCOMMAND');
  103.     CvsHome        = ReadIniValue(, IniAppName, 'CVS_HOME');
  104.     CvsUser        = ReadIniValue(, IniAppName, 'CVS_USER');
  105.     CvsPager       = ReadIniValue(, IniAppName, 'CVS_PAGER');
  106.  
  107.     MissingVar = '';
  108.     SELECT
  109.        WHEN (CvsServer = '')      THEN MissingVar = 'Open Source CVS Archive Server';
  110.        WHEN (CvsWorkRoot = '')    THEN MissingVar = 'root directory for working directories';
  111.        WHEN (CvsHome = '')        THEN MissingVar = 'homedirectory';
  112.        WHEN (CvsUser = '')        THEN MissingVar = 'user id';
  113.        OTHERWISE NOP;
  114.     END;
  115.  
  116.     IF (MissingVar \= '') THEN
  117.     DO
  118.        ErrorMsg = 'The' MissingVar 'is not defined.' CRLF||,
  119.                   'Run INSTALL.CMD first.';
  120.        rc = ERROR.ENVVAR_NOT_FOUND
  121.        LEAVE;
  122.     END;
  123.  
  124.     /* comamnd to be executed ? */
  125.     IF (CvsInitCommand \= '') THEN
  126.        'CALL' CvsInitCommand;
  127.  
  128.     /* make CVS binaries available */
  129.     rc = SetCVSPath( ReadIniValue(, IniAppName, 'CVS_BINROOT'));
  130.     IF (rc \= ERROR.NO_ERROR) THEN
  131.        LEAVE;
  132.  
  133.     /* -------------------------------------------------------------- */
  134.  
  135.     /* check parms */
  136.     ArchiveVar = VALUE( ArchiveVarname, '', env);
  137.     PARSE ARG Archive Action Option;
  138.     Archive = STRIP( Archive);
  139.     SELECT
  140.        WHEN (POS( LEFT(Archive, 1), ValidSwichChars) > 0) THEN
  141.        DO
  142.           PARSE ARG  Action Option;
  143.           Archive = STRIP( ArchiveVar);
  144.        END;
  145.  
  146.        OTHERWISE
  147.      END;
  148.  
  149.      OptionValue = Option;
  150.      Option      = STRIP(TRANSLATE( Option));
  151.      Action      = TRANSLATE( Action);
  152.  
  153.     /* - set ARCHIVE */
  154.     rcx = VALUE( ArchiveVarname, Archive, env);
  155.  
  156.     /* handle different switch characters */
  157.     IF ( POS( LEFT( Action, 1), ValidSwichChars) > 0) THEN
  158.        Action = OVERLAY( '/', Action);
  159.  
  160.     /* check option */
  161.     SELECT
  162.        WHEN (POS( Action, ValidSwichChars) > 0) THEN
  163.        DO
  164.           ErrorMsg = 'Invalid action specified';
  165.           rc = ERROR.INVALID_PARAMETER;
  166.        END;
  167.  
  168.        WHEN (POS(Action, '/BIN') = 1) THEN
  169.        DO
  170.           rcx = DIRECTORY( Calldir);
  171.           rc = ERROR.NO_ERROR;
  172.           LEAVE;
  173.        END;
  174.  
  175.        WHEN (POS(Action, '/USER') = 1) THEN
  176.        DO
  177.           NewUser = STRIP( OptionValue);
  178.           IF (NewUSer = '') THEN
  179.           DO
  180.              ErrorMsg = 'No user name specified';
  181.              rc = ERROR.INVALID_PARAMETER;
  182.           END;
  183.           ELSE
  184.           DO
  185.              CvsUser = NewUser;
  186.              CALL CHAROUT, 'switching user to' CvsUser '... ';
  187.              rcx = SysIni(, IniAppName, 'CVS_USER', CvsUser);
  188.              SAY 'Ok.';
  189.              fFixSnapshot = TRUE;
  190.           END;
  191.        END;
  192.  
  193.        WHEN (POS(Action,'/GETLIST') = 1) THEN
  194.        DO
  195.           rc = GetArchiveList( CvsServer, Ftp._User, Ftp._Passwd, Ftp._File, ArchiveFile);
  196.           'PAUSE';
  197.           RETURN(rc);
  198.        END;
  199.  
  200.        /* internal version of GETLIST for WPS object */
  201.        WHEN (POS(Action,'/GETLIST$') = 1) THEN
  202.        DO
  203.           rc = GetArchiveList( CvsServer, Ftp._User, Ftp._Passwd, Ftp._File, ArchiveFile);
  204.           IF ((rc \= ERROR.NO_ERROR) & (rc \= ERROR.INVALID_FUNCTION)) THEN
  205.              'PAUSE';
  206.           'CALL' CallDir'\CVSWPS';
  207.           RETURN(rc);
  208.        END;
  209.  
  210.        WHEN (POS(Action, '/LIST') = 1) THEN
  211.           EXIT( ShowList( ArchiveFile, PrivateFile, ShowListTitle, EmptyListMessage));
  212.  
  213.        WHEN (POS(Action, '/SHOWLIST') = 1) THEN
  214.        DO
  215.           /* special treatment, when called by WPS icon */
  216.           'CLS';
  217.           SAY;
  218.           rc = ShowList( ArchiveFile, PrivateFile, ShowListTitle, EmptyListMessage);
  219.           'PAUSE';
  220.           SAY;
  221.           EXIT( rc);
  222.        END;
  223.  
  224.        WHEN ((Archive = '') | (POS(LEFT(Archive, 1),'!$') > 0 )) THEN
  225.        DO
  226.           ErrorMsg = 'No archive name specified';
  227.           rc = ERROR.INVALID_PARAMETER;
  228.        END;
  229.  
  230.        WHEN (POS(Action, '/WORK') = 1) THEN
  231.           Action = '';
  232.  
  233.  
  234.        WHEN (POS( Action, '/FIXSNAPSHOT') = 1)  THEN
  235.           fFixSnapshot = TRUE;
  236.  
  237.        WHEN (POS(Action,'/REPORT') = 1) THEN
  238.           fChangeReport = TRUE;
  239.  
  240.        /* for all other options: make sure archive file exists */
  241.        WHEN (\FileExist( ArchiveFile)) THEN
  242.        DO
  243.           SAY CmdName': The archive list file is required, but missing.';
  244.           rc = GetArchiveList( CvsServer, Ftp._User, Ftp._Passwd, Ftp._File, ArchiveFile);
  245.           IF (rc \= ERROR.NO_ERROR) THEN
  246.           DO
  247.              ErrorMsg = 'Cannot continue without archive list file.';
  248.              rc =  ERROR.GEN_FAILURE;
  249.              LEAVE;
  250.           END;
  251.        END;
  252.  
  253.        WHEN (POS(Action, '/MODULES') = 1) THEN
  254.          EXIT(ShowModuleList( Archive, CvsWorkRoot'\'Archive'\CVSROOT\Modules'));
  255.  
  256.        WHEN (WORDPOS( Action, ValidCvsenvCommands) > 0) THEN NOP;
  257.  
  258.        WHEN (Action \= '') THEN
  259.        DO
  260.           ErrorMsg = 'invalid option' SUBSTR( Action, 2) 'specified.';
  261.           rc = ERROR.INVALID_PARAMETER;
  262.        END;
  263.  
  264.        OTHERWISE NOP;
  265.  
  266.     END;
  267.  
  268.     IF (rc \= ERROR.NO_ERROR) THEN
  269.        LEAVE;
  270.  
  271.     /* -------------------------------------------------------------- */
  272.  
  273.     /* set envrionment var */
  274.     CALL CHAROUT, 'Initialize environment for Archive' Archive '... ';
  275.  
  276.     /* extend path to this directory, making cvsenv available */
  277.     AddToPath = CallDir';';
  278.     CurrentPath = VALUE( 'PATH',,env);
  279.     IF (POS( AddToPath, CurrentPath) = 0) THEN
  280.        rcx = VALUE('PATH', AddToPath''CurrentPath,env);
  281.  
  282.     /* determine archive root for archive */
  283.     CvsArchiveRoot = GetArchiveRoot( Archive, ArchiveFile);
  284.     IF (CvsArchiveRoot = '') THEN
  285.        CvsArchiveRoot = GetArchiveRoot( Archive, PrivateFile);
  286.  
  287.     IF (CvsArchiveRoot = '') THEN
  288.     DO
  289.        /* reset to old archive name */
  290.        rcx = VALUE( ArchiveVarname, ArchiveVar, env);
  291.        SAY;
  292.        ErrorMsg = 'Archive' Archive 'could not be found in the archive list file.';
  293.        rc = ERROR.INVALID_DATA;
  294.        LEAVE;
  295.     END;
  296.  
  297.     CvsRoot = unixslash( ':pserver:'CvsUser'@'CvsArchiveRoot);
  298.  
  299.     /* - set CVSROOT */
  300.     rcx = VALUE( 'CVSROOT', CvsRoot, env);
  301.     SAY 'Ok.';
  302.  
  303.     /* - set homedirectory */
  304.     rcx = VALUE('HOME', dosslash(CvsHome), env);
  305.  
  306.     /* - set user id */
  307.     rcx = VALUE('USER', CvsUser, env);
  308.  
  309.     /* -------------------------------------------------------------- */
  310.  
  311.     IF (fChangeReport) THEN
  312.     DO
  313.        rc = CvsReport();
  314.        LEAVE;
  315.     END;
  316.  
  317.     /* -------------------------------------------------------------- */
  318.  
  319.     IF (fFixSnapshot) THEN
  320.     DO
  321.        rc = FixArchiveSnapshot(CvsRoot);
  322.        LEAVE;
  323.     END;
  324.  
  325.     /* -------------------------------------------------------------- */
  326.  
  327.     /* change to working dir of archive */
  328.     IF (CvsWorkRoot \= '') THEN
  329.     DO
  330.        WorkDir = CvsWorkRoot'\'Archive;
  331.        IF (\DirExist( WorkDir)) THEN
  332.           rcx = MakePath( WorkDir);
  333.        rcx = DIRECTORY( WorkDir);
  334.     END;
  335.  
  336.     /* -------------------------------------------------------------- */
  337.  
  338.     /* Perform action specified in Option */
  339.     rc = ProcessArchive( CvsWorkRoot'\'Archive, Action, OptionValue);
  340.  
  341.  END;
  342.  
  343.  /* exit */
  344.  IF (rc \= ERROR.NO_ERROR) THEN
  345.  DO
  346.     SAY CmdName': Error:' ErrorMsg;
  347.     'PAUSE'
  348.  END;
  349.  EXIT( rc);
  350.  
  351.  
  352. /* ------------------------------------------------------------------------- */
  353. HALT:
  354.  SAY 'Interrupted by user.';
  355.  EXIT(ERROR.GEN_FAILURE);
  356.  
  357. /* ------------------------------------------------------------------------- */
  358. ShowHelp: PROCEDURE EXPOSE (GlobalVars)
  359.  
  360.  SAY Title;
  361.  SAY;
  362.  
  363.  PARSE SOURCE . . ThisFile
  364.  DO i = 1 TO 3
  365.     rc = LINEIN(ThisFile);
  366.  END;
  367.  
  368.  ThisLine = LINEIN(Thisfile);
  369.  DO WHILE (ThisLine \= ' */')
  370.     SAY SUBSTR(ThisLine, 7);
  371.     ThisLine = LINEIN(Thisfile);
  372.  END;
  373.  
  374.  rc = LINEOUT(Thisfile);
  375.  
  376.  RETURN('');
  377.  
  378. /* ------------------------------------------------------------------------- */
  379. FileExist: PROCEDURE
  380.  PARSE ARG FileName
  381.  
  382.  RETURN(STREAM(Filename, 'C', 'QUERY EXISTS') > '');
  383.  
  384. /* ------------------------------------------------------------------------- */
  385. LOWER: PROCEDURE
  386.  
  387.  Lower = 'abcdefghijklmnopqrstuvwxyzäöü';
  388.  Upper = 'ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ';
  389.  
  390.  PARSE ARG String
  391.  RETURN(TRANSLATE(String, Lower, Upper));
  392.  
  393. /* ------------------------------------------------------------------------- */
  394. GetDrivePath: PROCEDURE
  395.  PARSE ARG FileName
  396.  
  397.  FullPath = FILESPEC('D', FileName)||FILESPEC('P', FileName);
  398.  IF (FullPath \= '') THEN
  399.     RETURN(LEFT(FullPath, LENGTH(FullPath) - 1));
  400.  ELSE
  401.     RETURN('');
  402.  
  403. /* ------------------------------------------------------------------------- */
  404. GetCalldir: PROCEDURE
  405. PARSE SOURCE . . CallName
  406.  CallDir = FILESPEC('Drive', CallName)||FILESPEC('Path', CallName);
  407.  RETURN(LEFT(CallDir, LENGTH(CallDir) - 1));
  408.  
  409. /* ------------------------------------------------------------------------- */
  410. ProceedWith: PROCEDURE
  411.  PARSE ARG Prompt
  412.  
  413.  ResponseKeys  = 'Y N A R I'; /* SysGetMessage(0); */
  414.  Yes           = WORD(ResponseKeys, 1);
  415.  No            = WORD(ResponseKeys, 2);
  416.  ch            = ' ';
  417.  ValidResponse = Yes||No;
  418.  
  419.  SAY;
  420.  CALL CHAROUT ,Prompt '('Yes'/'No') '
  421.  DO WHILE (POS(ch, ValidResponse) = 0)
  422.     ch = SysGetKey('NOECHO');
  423.     ch = TRANSLATE(ch);
  424.     IF (POS(ch, ValidResponse) = 0) THEN BEEP(800, 200);
  425.  END;
  426.  SAY;
  427.  SAY;
  428.  RETURN(ch = Yes);
  429.  
  430. /* ------------------------------------------------------------------------- */
  431. DirExist: PROCEDURE
  432.  PARSE ARG Dirname
  433.  
  434.  IF (Dirname = '') THEN
  435.     RETURN(0);
  436.  
  437.  /* use 'QUERY EXISTS' with root directories (???) */
  438.  IF (RIGHT(DirName, 2) = ':\') THEN
  439.    RETURN(STREAM(Dirname, 'C', 'QUERY EXISTS') \= '');
  440.  
  441.  /* query other directories this way */
  442.  IF ((STREAM(Dirname, 'C', 'QUERY EXISTS') = '') &,
  443.      (STREAM(Dirname, 'C', 'QUERY DATETIME') \= '')) THEN
  444.     RETURN(1);
  445.  ELSE
  446.     RETURN(0);
  447.  
  448. /* ========================================================================= */
  449. SetCVSPath: PROCEDURE EXPOSE (GlobalVars)
  450.  PARSE ARG CvsBinRoot;
  451.  
  452.  rc = ERROR.NO_ERROR;
  453.  
  454.  DO UNTIL (TRUE)
  455.  
  456.     /* - search CVS binaries */
  457.     fCvsFound = (SysSearchPath('PATH', 'CVS.EXE') \= '');
  458.  
  459.     IF (\fCvsFound) THEN
  460.     DO
  461.        IF (CvsBinRoot \= '') THEN
  462.           fCvsFound = FileExist( CvsBinRoot'\bin\cvs.exe');
  463.     END;
  464.  
  465.     IF (\fCvsFound) THEN
  466.     DO
  467.        ErrorMsg = 'CVS binaries could not be found!';
  468.        rc = ERROR.FILE_NOT_FOUND;
  469.        LEAVE;
  470.     END;
  471.  
  472.     /* - extend path to CVS binaries */
  473.     IF (SysSearchPath('PATH', 'CVS.EXE') = '') THEN
  474.     DO
  475.        AddToPath = CvsBinRoot'\bin;';
  476.        CurrentPath = VALUE( 'PATH',,env);
  477.        IF (POS( AddToPath, CurrentPath) = 0) THEN
  478.           rcx = VALUE('PATH', AddToPath''CurrentPath,env);
  479.     END;
  480.  END;
  481.  
  482.  RETURN(rc);
  483.  
  484. /* ========================================================================= */
  485. MakePath: PROCEDURE EXPOSE (GlobalVars)
  486.  PARSE ARG PathName
  487.  
  488.  PARSE SOURCE . . CallName
  489.  FileName = SUBSTR( CallName, LASTPOS( '\', CallName) + 1);
  490.  'XCOPY' CallName PathName'\' Redirection;
  491.  rcx = SysFileDelete( PathName'\'FileName);
  492.  RETURN( rc);
  493.  
  494. /* ========================================================================= */
  495. unixslash: PROCEDURE
  496.  PARSE ARG string
  497.  RETURN(TRANSLATE( string, '/', '\'));
  498.  
  499. /* ========================================================================= */
  500. dosslash: PROCEDURE
  501.  PARSE ARG string
  502.  RETURN(TRANSLATE( string, '\', '/'));
  503.  
  504. /* ========================================================================= */
  505. ReadIniValue: PROCEDURE
  506. PARSE ARG IniFile, IniAppname, IniKeyName
  507.  
  508.  IniValue = SysIni(IniFile, IniAppname, IniKeyName);
  509.  IF (IniValue = 'ERROR:') THEN
  510.     IniValue = '';
  511.  
  512.  IF ((IniValue \= '') & (RIGHT(IniValue, 1) = "00"x)) THEN
  513.     IniValue = LEFT( IniValue, LENGTH( IniValue) - 1);
  514.  
  515.  RETURN( IniValue);
  516.  
  517. /* ========================================================================= */
  518. ShowList: PROCEDURE EXPOSE (GlobalVars)
  519.  PARSE ARG ListFile, PrivateFile, Title, EmptyMsg;
  520.  
  521.  SAY Title;
  522.  SAY COPIES('-', LENGTH( Title));
  523.  Count = 0;
  524.  
  525.  /* process public list */
  526.  DO WHILE (LINES( ListFile) > 0)
  527.     ThisLine = LINEIN( ListFile);
  528.     IF (LEFT( ThisLine, 1) = '#') THEN
  529.        ITERATE;
  530.     Count = Count + 1;
  531.     SAY ThisLine
  532.  END;
  533.  rcx = STREAM( ListFile, 'C', 'CLOSE');
  534.  
  535.  /* process private list */
  536.  IF (FileExist( PrivateFile)) THEN
  537.  DO
  538.     SAY;
  539.     SAY 'Private Open Source Archives available for your personal use:';
  540.     SAY '-------------------------------------------------------------';
  541.     DO WHILE (LINES( PrivateFile) > 0)
  542.        ThisLine = LINEIN( PrivateFile);
  543.        IF (LEFT( ThisLine, 1) = '#') THEN
  544.           ITERATE;
  545.        Count = Count + 1;
  546.        SAY ThisLine
  547.     END;
  548.     rcx = STREAM( PrivateFile, 'C', 'CLOSE');
  549.  END;
  550.  
  551.  
  552.  IF (Count = 0) THEN
  553.  DO
  554.     SAY;
  555.     SAY EmptyMsg;
  556.  END;
  557.  SAY;
  558.  
  559.  RETURN(0);
  560.  
  561. /* ========================================================================= */
  562. ShowModuleList: PROCEDURE EXPOSE (GlobalVars)
  563.  PARSE ARG Archive, ListFile;
  564.  
  565.  rc         = ERROR.NO_ERROR;
  566.  Module.0   = 0;
  567.  NameMaxLen = 5;
  568.  
  569.  DO UNTIL (TRUE)
  570.     /* archive exists ? */
  571.     IF (\DirExist( ListFile'\..')) THEN
  572.     DO
  573.        SAY 'error: working directory for archive' Archive 'does not exist.';
  574.        rc = ERROR.PATH_NOT_FOUND;
  575.        LEAVE;
  576.     END;
  577.  
  578.     IF(\FileExist( ListFile)) THEN
  579.     DO
  580.        SAY 'error: module list not found for archive' Archive;
  581.        rc = ERROR.FILE_NOT_FOUND;
  582.        LEAVE;
  583.     END;
  584.  
  585.     /* determine Modules */
  586.     DO WHILE (LINES( ListFile) > 0)
  587.        ThisLine = LINEIN( ListFile);
  588.        IF (LEFT( ThisLine, 1) = '#') THEN
  589.           ITERATE;
  590.  
  591.        m        = Module.0 + 1;
  592.        Module.0 = m;
  593.        Module.m = ThisLine;
  594.        NameLen = LENGTH( WORD( ThisLine, 1));
  595.        IF (NameLen > NameMaxLen) THEN
  596.           NameMaxLen = NameLen;
  597.     END;
  598.     rcx = STREAM( ListFile, 'C', 'CLOSE');
  599.  
  600.     /* show result */
  601.     IF (Module.0 = 0) THEN
  602.        SAY 'No modules defined for archive:' Archive;
  603.     ELSE
  604.     DO
  605.        ModulesTitle = 'Modules defined for archive:' Archive;
  606.        'CLS'
  607.        SAY;
  608.        SAY ModulesTitle;
  609.        SAY COPIES('=', LENGTH( ModulesTitle));
  610.        SAY LEFT( 'name:', NameMaxLen) '  files in module:';
  611.        SAY COPIES('-', NameMaxLen) ' ' COPIES( '-', 30);
  612.  
  613.        DO m = 1 TO Module.0
  614.           PARSE VAR ThisLine ModuleName Files;
  615.           SAY LEFT( ModuleName, NameMaxLen) ' ' Files;
  616.        END;
  617.     END;
  618.  END;
  619.  
  620.  SAY;
  621.  'PAUSE';
  622.  SAY;
  623.  RETURN(rc);
  624.  
  625. /* ========================================================================= */
  626. GetArchiveList: PROCEDURE  EXPOSE (GlobalVars)
  627.  PARSE ARG HostList, User, Passwd, RemoteFile, LocalFile;
  628.  
  629.  rc       = ERROR.NO_ERROR;
  630.  HostList = TRANSLATE( SPACE( HostList, 0), ' ', ',');
  631.  fUpdated = FALSE;
  632.  
  633.  DO UNTIL (TRUE)
  634.  
  635.     SAY 'About to update the'
  636.     SAY;
  637.     SAY 'Open Source Archives List file';
  638.     SAY '------------------------------';
  639.     SAY;
  640.     SAY 'Note:  An internet connection is required for this !';
  641.     IF (\ProceedWith('Do you want to continue')) THEN
  642.     DO
  643.        SAY 'Update of list file aborted.';
  644.        RETURN( ERROR.INVALID_FUNCTION);
  645.     END;
  646.  
  647.     SAY 'Updating archive list from:';
  648.     SuccessList = '';
  649.     ErrorList = '';
  650.     DO WHILE (HostList \= '')
  651.        PARSE VAR HostList ThisHost HostList;
  652.        CALL CHAROUT, '-' ThisHost;
  653.        rc = GetArchiveListFromHost( ThisHost, User, Passwd, RemoteFile, LocalFile);
  654.        IF (rc = ERROR.NO_ERROR) THEN
  655.        DO
  656.           SuccessList = SuccessList ThisHost;
  657.           fUpdated = TRUE;
  658.        END;
  659.        ELSE
  660.           ErrorList = ErrorList ThisHost;
  661.        SAY;
  662.     END;
  663.  
  664.     /* done */
  665.     SAY 'The Open Source Archives List file'; 
  666.     IF (SuccessList \= '') THEN
  667.        SAY '- has been successfully updated from:'SuccessList;
  668.     IF (ErrorList \= '') THEN
  669.        SAY '- could not be updated from'ErrorList;
  670.  
  671.  END;
  672.  
  673.  RETURN( rc);
  674.  
  675.  
  676. /* ========================================================================= */
  677. GetArchiveListFromHost: PROCEDURE EXPOSE (GlobalVars)
  678.  PARSE ARG Host, User, Passwd, RemoteFile, LocalFile;
  679.  
  680.  CmdFile = SysTempFilename( VALUE('TMP',,env)'\ftp.???');
  681.  TmpFile = SysTempFilename( VALUE('TMP',,env)'\nosac.???');
  682.  rc      = ERROR.NO_ERROR;
  683.  DO UNTIL (TRUE)
  684.  
  685.     /* write command file */
  686.     rcx = LINEOUT( CmdFile, 'open' Host);
  687.     rcx = LINEOUT( CmdFile, 'quot user' User);
  688.     rcx = LINEOUT( CmdFile, 'quot pass' Passwd);
  689.     rcx = LINEOUT( CmdFile, 'get' RemoteFile TmpFile);
  690.     rcx = LINEOUT( CmdFile);
  691.  
  692.     /* get the remote file */
  693.     'ftp -n <' CmdFile Redirection;
  694.     rcx = SysFileDelete( CmdFile);
  695.     IF (\FileExist( TmpFile)) THEN
  696.     DO
  697.        rc = ERROR.ACCESS_DENIED;
  698.        LEAVE;
  699.     END;
  700.  
  701.     /* append all projects of other hosts to that file */
  702.     DO WHILE (LINES( LocalFile) > 0)
  703.        ThisProject = LINEIN( LocalFile);
  704.        PARSE VAR ThisProject ThisHost':'.;
  705.        IF (TRANSLATE(ThisHost) \= TRANSLATE( Host)) THEN
  706.           rcx = LINEOUT( TmpFile, ThisProject);
  707.     END;
  708.     rcx = STREAM( LocalFile, 'C', 'CLOSE');
  709.     rcx = STREAM( TmpFile, 'C', 'CLOSE');
  710.  
  711.     /* copy over the new file and cleanup */
  712.     'COPY' TmpFile LocalFile Redirection;
  713.     rcx = SysFileDelete( TmpFile);
  714.  
  715.  END;
  716.  
  717.  SAY;
  718.  RETURN( rc);
  719.  
  720. /* ========================================================================= */
  721. ProcessArchive: PROCEDURE EXPOSE (GlobalVars) CvsPager
  722.  PARSE ARG WorkRoot, Action, Files;
  723.  
  724.  /* defaults */
  725.  Tagname = '';
  726.  
  727.  /* check parms */
  728.  IF (Files = '') THEN
  729.     Files = '.';
  730.  Action = LOWER( STRIP( Action));
  731.  IF (Action = '') THEN
  732.     RETURN( ERROR.NO_ERROR);
  733.  ELSE
  734.     PARSE VAR Action ActionType +1 Action;
  735.  
  736.  /* get cvsroot */
  737.  CvsRoot = VALUE( 'CVSROOT',,env);
  738.  
  739.  /* perform command */
  740.  IF (ActionType = '!') THEN
  741.  DO
  742.     CvsUser = VALUE( 'USER',,env);
  743.     CvsRoot = VALUE( 'CVSROOT',,env);
  744.  
  745.     SAY;
  746.     SELECT
  747.        WHEN (Action = 'login') THEN
  748.        DO
  749.           IF (TRANSLATE(CvsUser) = 'GUEST') THEN
  750.           DO
  751.              SAY 'Specify "readonly" as password for access with the guest account !';
  752.              SAY;
  753.           END;
  754.        END;
  755.  
  756.        OTHERWISE NOP;
  757.     END;
  758.  
  759.     'CALL cvs -d' CvsRoot Action;
  760.     'PAUSE';
  761.  END;
  762.  ELSE
  763.  DO
  764.     /* process files: convert all absolute pathnames to names relative to working root */
  765.     FileList = ''
  766.     DO i = 1 TO WORDS(Files)
  767.        ThisFile = WORD( Files,i);
  768.  
  769.        IF (POS( ':\', ThisFile) > 1) THEN
  770.        DO
  771.           FileList = FileList DELSTR( ThisFile, 1, LENGTH( WorkRoot) + 1);
  772.        END;
  773.        ELSE
  774.           FileList = FileList ThisFile;
  775.     END;
  776.     Files = STRIP(FileList);
  777.  
  778.     /* perform CVS operation */
  779.     'CALL cvs' Action Files ' 2>&1 |' CvsPager;
  780.     IF (TRANSLATE( CvsPager) = 'MORE') THEN 'PAUSE';
  781.  END;
  782.  RETURN(0);
  783.  
  784. /* ========================================================================= */
  785. GetArchiveRoot: PROCEDURE EXPOSE (GlobalVars)
  786.  PARSE ARG ArchiveName, ArchiveFile;
  787.  
  788.  ArchiveRoot = '';
  789.  
  790.  DO UNTIL (TRUE)
  791.  
  792.     /* search project within file */
  793.     rc = SysFileSearch( ArchiveName, ArchiveFile, 'Line.');
  794.     IF (rc \= 0) THEN
  795.        LEAVE;
  796.  
  797.     DO i = 1 TO Line.0
  798.        IF (LEFT(Line.i,1) = ';' ) THEN ITERATE;
  799.  
  800.        /* if description is missing, append last part of path */
  801.        IF (WORDS( Line.i) < 2) THEN
  802.        DO
  803.           PathWords = TRANSLATE( Line, ' ', '/');
  804.           Line.i = Line.i WORD( PathWords, WORDS( PathWords));
  805.        END;
  806.        IF (WORDS( Line.i) < 2) THEN ITERATE;
  807.  
  808.        PARSE VAR Line.i ThisRoot ThisName
  809.        ThisName = STRIP(ThisName);
  810.        PARSE VAR ThisRoot ThisServer':'ThisDirectory;
  811.        ThisTag = FILESPEC('N', ThisDirectory);
  812.        IF (TRANSLATE(ThisTag) = TRANSLATE(ArchiveName)) THEN
  813.        DO
  814.           ArchiveRoot = ThisRoot;
  815.           LEAVE;
  816.        END;
  817.     END;
  818.  END;
  819.  
  820.  RETURN(ArchiveRoot);
  821.  
  822. /* ========================================================================= */
  823. FixArchiveSnapshot: PROCEDURE EXPOSE (GlobalVars)
  824.  PARSE ARG CvsRoot;
  825.  
  826.  /* search all files within the working directory */
  827.  Filename = '*';
  828.  Options  = 'OFS';
  829.  rc = SysFileTree(FileName, 'File.', Options);
  830.  IF (rc \= 0) THEN
  831.  DO
  832.     SAY 'Error in SysFileTree';
  833.     EXIT(8);
  834.  END;
  835.  
  836.  IF (File.0 = 0) THEN
  837.  DO
  838.     SAY 'No files found to fix.';
  839.     EXIT(ERROR.NO_MORE_FILES);
  840.  END;
  841.  
  842.  RootFileName          = '\CVS\Root';
  843.  RootFileNameLen       = LENGTH( RootFileName);
  844.  RepositoryFileName    = '\CVS\Repository';
  845.  RepositoryFileNameLen = LENGTH( RepositoryFileName);
  846.  
  847.  SAY;
  848.  CALL CHAROUT, 'Fixing CVS files ';
  849.  DO i = 1 TO File.0
  850.     SELECT
  851.        WHEN (RIGHT( File.i, RootFileNameLen) = RootFileName) THEN
  852.        DO
  853.           CALL CHAROUT, '.';
  854.           rc = SysFileDelete( File.i);
  855.           rc = LINEOUT( File.i, CvsRoot);
  856.           rc = LINEOUT( File.i);
  857.        END;
  858.  
  859.        WHEN (RIGHT( File.i, RepositoryFileNameLen) = RepositoryFileName) THEN
  860.        DO
  861.           CvsRepository = LINEIN( File.i);
  862.           rc = LINEOUT( File.i);
  863.           IF (POS('\', CvsRepository) > 0) THEN
  864.           DO
  865.              CALL CHAROUT, '.';
  866.              rc = SysFileDelete( File.i);
  867.              rc = LINEOUT( File.i, unixslash(CvsRepository));
  868.              rc = LINEOUT( File.i);
  869.           END;
  870.        END;
  871.  
  872.        OTHERWISE NOP
  873.     END;  /* select */
  874.  END;
  875.  
  876.  SAY ' Done.'
  877.  SAY;
  878.  
  879.  EXIT(rc);
  880.  
  881.