InfoMagic Internet Tools 1993 July/Internet Tools.iso/RockRidge/info-service/gopher/Rice_CMS/gopher24/gopsrvls.rexx

OS/2 REXX Batch file | 1993-01-20 | 5.8 KB | 187 lines

/*
 *        Name: GOPSRVLS REXX
 *              list a file or directory, feeding to the next stage
 *      Author: Rick Troth, Rice University, Information Systems
 *        Date: 1993-Jan-15, 19
 */

/*
 *      Copyright 1993 Richard M. Troth.   This software was developed
 *      with resources provided by Rice University and is intended
 *      to serve Rice's user community.   Rice has benefitted greatly
 *      from the free distribution of software,  therefore distribution
 *      of unmodified copies of this material is not restricted.
 *      You may change your own copy as needed.   Neither Rice
 *      University nor any of its employees or students shall be held
 *      liable for damages resulting from the use of this software.
 */

Parse Source . . arg0 .
Parse Upper Arg fn ft fm . '(' . ')' .
If fn = "" Then fn = '*'
If ft = "" Then ft = '*'
If ft = "FILELIST" & Index(fn,'*') = 0 Then ft = "*"
If fm = "" Then fm = '*'

Parse Arg string
Say arg0 || ':' string

Address "COMMAND" 'GLOBALV SELECT GOPHERD GET MENU NICK CLIENT'

If menu ^= "" Then Do


    Address "CMS" 'STATE' menu 'NAMES *'
    If rc = 0 Then Do

        If nick = "" Then nick = "*"

        'CALLPIPE COMMAND NAMEFIND :NICK' nick ':AUTH :PIPE' ,
                '(FILE' menu '| VAR AUTH | DROP' ,
        '| CHANGE' '00'x || '&0' || '00'x || nick || '00'x ,
        '| CHANGE' '00'x || '&1' || '00'x ||  fn  || '00'x ,
        '| CHANGE' '00'x || '&2' || '00'x ||  ft  || '00'x ,
        '| CHANGE' '00'x || '&3' || '00'x ||  fm  || '00'x ,
        '| CHANGE' '00'x || '&4' || '00'x || menu || '00'x ,
                '| VAR PIPE'

        If rc = 32 Then
        'CALLPIPE COMMAND NAMEFIND :FN' fn ':FT' ft ':AUTH :PIPE' ,
                '(FILE' menu '| VAR AUTH | DROP' ,
        '| CHANGE' '00'x || '&0' || '00'x || nick || '00'x ,
        '| CHANGE' '00'x || '&1' || '00'x ||  fn  || '00'x ,
        '| CHANGE' '00'x || '&2' || '00'x ||  ft  || '00'x ,
        '| CHANGE' '00'x || '&3' || '00'x ||  fm  || '00'x ,
        '| CHANGE' '00'x || '&4' || '00'x || menu || '00'x ,
                '| VAR PIPE'

        If rc = 32 Then
        'CALLPIPE COMMAND NAMEFIND :NICK * :AUTH :PIPE' ,
                '(FILE' menu '| VAR AUTH | DROP' ,
        '| CHANGE' '00'x || '&0' || '00'x || nick || '00'x ,
        '| CHANGE' '00'x || '&1' || '00'x ||  fn  || '00'x ,
        '| CHANGE' '00'x || '&2' || '00'x ||  ft  || '00'x ,
        '| CHANGE' '00'x || '&3' || '00'x ||  fm  || '00'x ,
        '| CHANGE' '00'x || '&4' || '00'x || menu || '00'x ,
                '| VAR PIPE'

        If rc = 0 Then Do

            /*  if auth non-blank  */
            If ^gopsrvau(client,auth) Then Do
                /*  "access restricted"  */
                'CALLPIPE COMMAND XMITMSG 2380' ,
                    '(CALLER GOP ERRMSG' ,
                        '| SPEC /- / 1 1-* NEXT | *:'
                Exit rc
                End  /*  If  ..  Do  */

            If pipe ^= "" Then Do
                'CALLPIPE' pipe '| *:'
                Exit rc
                End  /*  If  ..  Do  */

            End  /*  If  ..  Do  */

        End  /*  If  ..  Do  */

    End  /*  If  ..  Do  */

If ft = '*' Then Do

    Address "CMS" 'STATE' fn 'NAMES *'
    If rc = 0 Then Do

        'CALLPIPE COMMAND NAMEFIND :NICK . :AUTH :PIPE' ,
                '(FILE' fn '| VAR AUTH | DROP' ,
        '| CHANGE' '00'x || '&0' || '00'x || nick || '00'x ,
        '| CHANGE' '00'x || '&1' || '00'x ||  fn  || '00'x ,
        '| CHANGE' '00'x || '&2' || '00'x ||  ft  || '00'x ,
        '| CHANGE' '00'x || '&3' || '00'x ||  fm  || '00'x ,
        '| CHANGE' '00'x || '&4' || '00'x || menu || '00'x ,
                '| VAR PIPE'

        If rc = 0 Then Do

            /*  if auth non-blank  */
            If ^gopsrvau(client,auth) Then Do
                /*  "access restricted"  */
                'CALLPIPE COMMAND XMITMSG 2380' ,
                    '(CALLER GOP ERRMSG' ,
                        '| SPEC /- / 1 1-* NEXT | *:'
                Exit rc
                End  /*  If  ..  Do  */

            If pipe ^= "" Then Do
                menu = fn
                Address "COMMAND" 'GLOBALV SELECT GOPHERD PUT MENU'
                'CALLPIPE' pipe '| *:'
                Exit rc
                End  /*  If  ..  Do  */

            End  /*  If  ..  Do  */

        End  /*  If  ..  Do  */

    End  /*  If  ..  Do  */

If Index(fn ft, '*') = 0 Then Do
    Address "CMS" 'STATE' fn ft fm
    If rc = 0 Then Do
        'CALLPIPE <' fn ft fm '| *:'
        Exit rc
        End
    Exit rc
    End

If Index(fn,'*') = 0 & ft = '*' Then Do

    Address "COMMAND" 'GLOBALV SELECT GOPHERD SET MENU' fn

    Address "CMS" 'STATE' fn 'FILELIST' fm
    If  rc = 0  Then Do     /*  menu is a FILELIST  */
        'CALLPIPE <' fn 'FILELIST' fm '| *:'
        Exit rc
        End  /*  If  ..  Do  */

    If fm = '*' | fm = "" Then fm = 'A'
    'CALLPIPE COMMAND ACCESS +' || fm || '.' || fn fm
    If rc = 0 Then Do
        /*  menu is an SFS sub-directory  */
        'CALLPIPE' arg0 '* *' fm '| *:'
        lrc = rc
        'CALLPIPE COMMAND ACCESS -' || fm fm
        Exit lrc
        End  /*  If  ..  Do  */
    If rc = 28 | rc = 100 Then Exit rc
    End

/*  shortcut for GOPSRVRP on LISTFILE not FILELIST  */
'OUTPUT' " "
If rc ^= 0 Then Exit rc * (rc ^= 12)

/*  list all files in this directory  */
'ADDPIPE COMMAND LISTFILE' fn ft fm '(ALLFILE ALLOC NOHEADER | *.INPUT:'
If rc ^= 0 Then Do
    'CALLPIPE COMMAND LISTFILE' fn ft fm '(NOHEADER | *:'
    Exit rc
    End  /*  If  ..  Do  */

/*  give SFS directories a filetype '*'  */
Do Forever

    'PEEKTO RECORD'
    If rc ^= 0 Then Leave

    Parse Var record fn ft fm .
    If fm = "DIR" Then 'OUTPUT' "     " fn '*' ft
                  Else 'OUTPUT' "     " fn ft fm

    'READTO'
    If rc ^= 0 Then Leave

    End  /*  If  ..  Do  Forever  */

Exit rc * (rc ^= 12)