From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 21-APR-1989 16:19
To:	MRGATE::"ARISIA::EVERHART"
Subj:	LOGIN.FOR example

Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Fri, 21 APR 89 11:27:58 PDT
Received: from ucbvax.Berkeley.EDU by KL.SRI.COM with TCP; Fri, 21 Apr 89 11:02:24 PDT
Received: by ucbvax.Berkeley.EDU (5.61/1.36)
	id AA17165; Fri, 21 Apr 89 10:53:31 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews
	for info-vax@kl.sri.com (info-vax@kl.sri.com)
	(contact usenet@ucbvax.Berkeley.EDU if you have questions)
Date: 21 Apr 89 17:24:59 GMT
From: krypton.arc.nasa.gov!howells@ames.arc.nasa.gov  ("Mr. Neutron")
Organization: Aeroflightdynamics Directorate
Subject: LOGIN.FOR example
Message-Id: <24207@ames.arc.nasa.gov>
Sender: info-vax-request@kl.sri.com
To: info-vax@kl.sri.com


With all this talk about converting DCL procedures to images, I thought it
might be useful for me to post my LOGIN.FOR program in FORTRAN which does
almost everything that LOGIN.COM does (except for defining PF and function keys
- haven't found a way to do that). Of course my symbol and logicals are not
going to help you much, but it is an example of what can be done.

------------------------------< cut here >---------------------------------

        Program LOGIN
C
C Login program which does everything that a LOGIN.COM normally does. 
C John Howells - Sterling Software.                                    
C
        Implicit Integer*4 (a-z)
        Include '($jpidef)'
        Include '($syidef)'
        Include '($prvdef)'
        Include '($lnmdef)'

        Byte Enbflg, Prmflg
        Integer*4 Sys$Setprn
        Integer*4 Priv_Mask
        Character*1 Escape, CCount
        Character*2 Number
        Character*3 Whatnode
        Character*4 Bold, Normal
        Character*10 Nodename
        Character*11 Mode_state
        Character*16 ProcessName, Username
        Character*24 Lastboot, Nextdown
        Character*30 Prompt
        Character*80 CommandLine

        Escape = char(27)
        Bold   = Escape//'[1m'
        Normal = Escape//'[0m'
        Enbflg = 1
        Prmflg = 1                                  

        Priv_mask = Prv$M_Altpri.or.Prv$M_Cmkrnl.or.Prv$M_Oper.or.
     .          Prv$M_Sysprv.or.Prv$M_World.or.Prv$M_Sysnam
C
C Determine the nodename
C
        Call Lib$Getsyi ( Syi$_Nodename ,, Whatnode )
C
C Set up logical names
C
        Call Lib$Set_Logical ( 'HOME', '$9$DRA1:[HOWELLS.]' ,,
     .          Lnm$M_Concealed )
        Call Lib$Set_Logical ( 'TEX_PXLDIR', 
     .          '$9$DRA3:[TEX201.TEX.PIXEL.]' ,, Lnm$M_Concealed )

        if (Whatnode(1:3).eq.'KRY') then
           Call Lib$Set_Logical ( 'SRC', '$9$DRB3:[SOURCE.]' ,,
     .          Lnm$M_Concealed )
        elseif (Whatnode(1:3).eq.'XEN') then
           Call Lib$Set_Logical ( 'SRC', 'XEN$DUA0:[SOURCE.]' ,,
     .          Lnm$M_Concealed )
        endif

        Call Lib$Set_Logical ( 'SHOW_CLUSTER$INIT',
     .          'SYS$LOGIN:CLUSTER.INI' ) 
        Call Lib$Set_Logical ( 'SHUTDOWN$INFORM_NODES', Whatnode )
        Call Lib$Set_Logical ( 'MAIL$INIT', 'SYS$LOGIN:MAIL.INI' )
        Call Lib$Set_Logical ( 'TEXT', 'DISK$USERA1:[HOWELLS.TEXT]' )
        Call Lib$Set_Logical ( 'TEXT$DIR', 'DISK$USERA1:[HOWELLS.TEXT]' )
        Call Lib$Set_Logical ( 'COM', 'DISK$USERA1:[HOWELLS.COM]' )
        Call Lib$Set_Logical ( 'COM$DIR', 'DISK$USERA1:[HOWELLS.COM]' )
        Call Lib$Set_Logical ( 'FOR$EXAMPLES', 
     .          'DISK$USERA1:[HOWELLS.FOR.EXAMPLES]' )
        Call Lib$Set_Logical ( 'HUH', 'DISK$USERA1:[HOWELLS.HUH]' )
        Call Lib$Set_Logical ( 'TEX', 'DISK$USERA1:[HOWELLS.TEX]' )
        Call Lib$Set_Logical ( 'EXE', 'DISK$USERA1:[HOWELLS.EXE]' )
        Call Lib$Set_Logical ( 'FOR', 'DISK$USERA1:[HOWELLS.FOR]' )
        Call Lib$Set_Logical ( 'MGR', 'SYS$COMMON:[SYSMGR]' )
        Call Lib$Set_Logical ( 'SYS', 'SYS$COMMON:[SYSEXE]' )
        Call Lib$Set_Logical ( 'LIB', 'SYS$COMMON:[SYSLIB]' )
        Call Lib$Set_Logical ( 'HLP', 'SYS$COMMON:[SYSHLP]' )
        Call Lib$Set_Logical ( 'LDR', 'SYS$COMMON:[SYS$LDR]' )
        Call Lib$Set_Logical ( 'SPECMGR', 'SYS$SPECIFIC:[SYSMGR]' )
        Call Lib$Set_Logical ( 'SPECSYS', 'SYS$SPECIFIC:[SYSEXE]' )
        Call Lib$Set_Logical ( 'SPECHLP', 'SYS$SPECIFIC:[SYSHLP]' )
        Call Lib$Set_Logical ( 'SPECLIB', 'SYS$SPECIFIC:[SYSLIB]' )
        Call Lib$Set_Logical ( 'SPECMSG', 'SYS$SPECIFIC:[SYSMSG]' )
        Call Lib$Set_Logical ( 'TPU$SECTION', 'EDTSECINI' )
        Call Lib$Set_Logical ( 'EDTINI', 'TEXT$DIR:EDTINI.EDT' )
        Call Lib$Set_Logical ( 'REC$OVER', 
     .          'SYS$SYSDEVICE:[BACKUP.INDEX]' )
        Call Lib$Set_Logical ( 'LNK$LIBRARY', 'LIB:VAXCCURSE' )
        Call Lib$Set_Logical ( 'LNK$LIBRARY_1', 'LIB:VAXCRTL' )
        Call Lib$Set_Logical ( 'MAIL$EDIT', 'CALLABLE_TPU' )
        Call Lib$Set_Logical ( 'SWING$PRINT',
     .          '$PRINT/QUEUE=LASER/FORM=PORTRAIT' )
        Call Lib$Set_Logical ( 'NEWS_PRINT',
     .          'PRINT/QUEUE=LASER/FORM=PORTRAIT' )
        Call Lib$Set_Logical ( 'SWING_SAVE', 'HOME:[SWING]' )
        Call Lib$Set_Logical ( 'SYS$TOOLS', 
     .          'EAR::$4$DUA50:[SYS_TOOLS]' )
        Call Lib$Set_Logical ( 'NNTP_SERVER', 'AMELIA' )
        Call Lib$Set_Logical ( 'VISUAL', 'EDIT/TPU' )
        Call Lib$Set_Logical ( 'RNINIT', '-e -m -N -S -/' )
        Call Lib$Set_Logical ( 'NAME', '"Mr. Neutron"' )
        Call Lib$Set_Logical ( 'SYS$ALARM', 
     .          'DISK$USERA1:[HOWELLS.ALARM]' )
C
C Set up symbols
C
        Call Lib$Set_Symbol ( 'ALIAS', '$EXE:ALIAS', 2 )
        Call Lib$Set_Symbol ( 'ALL', 'SET PROC/PRIV=ALL', 2 )
        Call Lib$Set_Symbol ( 'ANNOY', 'SET TERM/BROADCAST', 2 )
        Call Lib$Set_Symbol ( 'ASK', '@COM$DIR:ASK', 2 )
        Call Lib$Set_Symbol ( 'BB', '$EXE:BIGBRO', 2 )
        Call Lib$Set_Symbol ( 'BLK', 'MC BLK', 2 )
        Call Lib$Set_Symbol ( 'BOTT', '@COM$DIR:BOTT', 2 )
        Call Lib$Set_Symbol ( 'BYPASS', 'SET PROC/PRIV=BYPASS', 2 )
        Call Lib$Set_Symbol ( 'CB', '@COM:CHECK_BACK', 2 )
        Call Lib$Set_Symbol ( 'CD', '$SD', 2 )
        Call Lib$Set_Symbol ( 'CHANGE', '$EXE:CHANGE', 2 )
        Call Lib$Set_Symbol ( 'CMP', '@COM:COMPRESS', 2 )
        Call Lib$Set_Symbol ( 'CP', 'COPY', 2 )
        Call Lib$Set_Symbol ( 'CRIP*PLE', '$EXE:CRIPPLE', 2 )
        Call Lib$Set_Symbol ( 'DCM', '@COM:UNCOMPRESS', 2 )
        Call Lib$Set_Symbol ( 'DEL', 'DELETE/LOG', 2 )
        Call Lib$Set_Symbol ( 'DIRT', 'DIR/DAT/PRO/SINCE=TODAY', 2 )
        Call Lib$Set_Symbol ( 'DIRY', 'DIR/DAT/PRO/SINCE=YESTERDAY', 2 )
        Call Lib$Set_Symbol ( 'DIRS', 'DIR/SIZ', 2 )
        Call Lib$Set_Symbol ( 'DIRP', 'DIR/PRO', 2 )
        Call Lib$Set_Symbol ( 'DIRD', 'DIR/DAT', 2 )
        Call Lib$Set_Symbol ( 'DISKQ', 'MC DISKQUOTA', 2 )
        Call Lib$Set_Symbol ( 'DISKS', 'SH DEV D/M', 2 )
        Call Lib$Set_Symbol ( 'DQ', '$DSQEX', 2 )
        Call Lib$Set_Symbol ( 'ESP', '@COM:ESP', 2 )
        Call Lib$Set_Symbol ( 'E*VE', 'EDIT/TPU', 2 )
        Call Lib$Set_Symbol ( 'FAST', 'TYPE/NOPAGE TEXT$DIR:FAST.LIS', 
     .          2 )
        Call Lib$Set_Symbol ( 'F', '$EXE:WHO', 2 )
        Call Lib$Set_Symbol ( 'FLIST', '@COM$DIR:FLIST', 2 )
        Call Lib$Set_Symbol ( 'FORCE', '$EXE:FORCE', 2 )
        Call Lib$Set_Symbol ( 'FRAG', '$FRAG', 2 )
        Call Lib$Set_Symbol ( 'FULL', '@COM$DIR:FULL', 2 )
        Call Lib$Set_Symbol ( 'GOD', '$SYS$MASTER:PROFILE', 2 )
        Call Lib$Set_Symbol ( 'GO*OSE', '$EXE:GOOSE', 2 )
        Call Lib$Set_Symbol ( 'HEAD', '$EXE:HEAD', 2 )
        Call Lib$Set_Symbol ( 'H*ELP', 'HELP/NOINSTRUCTIONS', 2 )
        Call Lib$Set_Symbol ( 'HIST*ORY', 'RECALL/ALL', 2 )
        Call Lib$Set_Symbol ( 'HOLD', '@SYS$MANCOM:HOLD', 2 )
        Call Lib$Set_Symbol ( 'KILL', '@SYS$MANCOM:KILL', 2 )
        Call Lib$Set_Symbol ( 'KRY', '@SYS$LOGIN:TO KRY', 2 )
        Call Lib$Set_Symbol ( 'LASER', 
     .          '$PRINT/QUEUE=LASER/FORM=PORTRAIT', 2 )
        Call Lib$Set_Symbol ( 'LCP', '$LATCP', 2 )
        Call Lib$Set_Symbol ( 'LS', '$EXE:LS', 2 )
        Call Lib$Set_Symbol ( 'MKDIR', '$EXE:MKDIR', 2 )
        Call Lib$Set_Symbol ( 'MV', 'RENAME', 2 )
        Call Lib$Set_Symbol ( 'N', 'REPLY/ABORT=', 2 )
        Call Lib$Set_Symbol ( 'NCP', 'MC NCP', 2 )
        Call Lib$Set_Symbol ( 'NEWS_PRINT', 
     .          '$PRINT/QUE=LASER/FORM=PORTRAIT', 2 )
        Call Lib$Set_Symbol ( 'NOBYPASS', 'SET PROC/PRIV=NOBYPASS', 2 )
        Call Lib$Set_Symbol ( 'NODE', '@COM$DIR:NODE', 2 )
        Call Lib$Set_Symbol ( 'NONE', 
     .          'SET PROC/PRIV=(NOALL,TMPMBX,NETMBX)', 2 )
        Call Lib$Set_Symbol ( 'NOSYSPRV', 'SET PROC/PRIV=NOSYSPRV', 2 )
        Call Lib$Set_Symbol ( 'NOTE', '@SYS$SYSROOT:[SYSNOTE]NOTE', 2 )
        Call Lib$Set_Symbol ( 'OPER', 'SET PROC/PRIV=OPER', 2 )
        Call Lib$Set_Symbol ( 'PEON', '@COM:PEON', 2 )
        Call Lib$Set_Symbol ( 'PHBOOK', '$PHBOOK', 2 )
        Call Lib$Set_Symbol ( 'POPP', '$EXE:POP_PASSWORD', 2 )
        Call Lib$Set_Symbol ( 'PRINTLASER', '$PRINT/QUEUE=LASER', 2 )
        Call Lib$Set_Symbol ( 'PROT', 'SET PROT=(S:R,O:R,G,W)', 2 )
        Call Lib$Set_Symbol ( 'PS', '$EXE:PS', 2 )
        Call Lib$Set_Symbol ( 'PUR', 'PURGE/LOG', 2 )
        Call Lib$Set_Symbol ( 'PUSHP', '$EXE:PUSH_PASSWORD', 2 )
        Call Lib$Set_Symbol ( 'PWD', 'SHOW DEFAULT', 2 )
        Call Lib$Set_Symbol ( 'QSP*AWN', 
     .          'SPAWN/NOWAIT/NOTIFY/NOLOGIC/NOSYM', 2 )
        Call Lib$Set_Symbol ( 'RE', 'REPLY/STAT', 2 )
        Call Lib$Set_Symbol ( 'RELEASE', '@SYS$MANCOM:RELEASE', 2 )
        Call Lib$Set_Symbol ( 'REMIND',
     .          'SUBMIT/QUE=BAT$FAST/AFTER="+:15" SYS$LOGIN:REMIND', 2 )
        Call Lib$Set_Symbol ( 'RESET', '@COM$DIR:RESET', 2 )
        Call Lib$Set_Symbol ( 'RESU*ME', '$EXE:RESUME', 2 )
        Call Lib$Set_Symbol ( 'RM', 'DELETE/LOG', 2 )
        Call Lib$Set_Symbol ( 'ROGUE', '$SYS$GAMES:MORIA', 2 )
        Call Lib$Set_Symbol ( 'ROT13', '$EXE:ROT13', 2 )
        Call Lib$Set_Symbol ( 'RTIME', '@COM$DIR:RTIME', 2 )
        Call Lib$Set_Symbol ( 'SAY', 'WRITE SYS$OUTPUT', 2 )
        Call Lib$Set_Symbol ( 'SD', '$SD', 2 )
        Call Lib$Set_Symbol ( 'SHELL', '@COM:SHELL', 2 )
        Call Lib$Set_Symbol ( 'SHODEF', '$EXE:SHOWDEF', 2)
        Call Lib$Set_Symbol ( 'SHUTUP', 'SET TERM/NOBROADCAST', 2 )
        Call Lib$Set_Symbol ( 'SHQ', '$EXE:SHOQUOTA', 2 )
        Call Lib$Set_Symbol ( 'SLOW', 
     .          'TYPE/NOPAGE TEXT$DIR:SLOW.LIS', 2 )
        Call Lib$Set_Symbol ( 'SNAP', '$EXE:SNAP', 2 )
        Call Lib$Set_Symbol ( 'SNOOP', '$EXE:USSGETREC', 2 )
        Call Lib$Set_Symbol ( 'SOME',
     .          'SET PROC/PRIV=(NOALL,ALTPRI,TMPMBX,NETMBX,OPER,
     .SYSPRV,SYSNAM,CMKRNL,WORLD)', 2 )
        Call Lib$Set_Symbol ( 'SPACE', '@SYS$MANCOM:FRAG', 2 )
        Call Lib$Set_Symbol ( 'SPEAR', '$SYS$SYSROOT:[SPEAR]SPEAR', 2 )
        Call Lib$Set_Symbol ( 'SPY', 
     .          'SPY/ACTIVE_ONLY/TERMINAL/NOHELP', 2 )
        Call Lib$Set_Symbol ( 'SU', '@COM:SU', 2 )
        Call Lib$Set_Symbol ( 'SUSP*END', '$EXE:SUSPEND', 2 )
        Call Lib$Set_Symbol ( 'SW', '$SWING', 2 )
        Call Lib$Set_Symbol ( 'SYSGEN', 'MC SYSGEN', 2 )
        Call Lib$Set_Symbol ( 'SYSMOUNT', '@SYS$MANCOM:SYSMOUNT', 2 )
        Call Lib$Set_Symbol ( 'SYSPRV', 'SET PROC/PRIV=SYSPRV', 2 )
        Call Lib$Set_Symbol ( 'T', 'TYPE', 2 )
        Call Lib$Set_Symbol ( 'TGRIND', 
     .          '@TEX$TGRIND:TGRIND PRINT EXCL QUE=TALARIS', 2 )
        Call Lib$Set_Symbol ( 'TLASER',
     .          '$PRINT/QUE=TALARIS/SETUP=(EXCL,PORT,CUTMT610)', 2 )
        Call Lib$Set_Symbol ( 'TOPP', '@COM$DIR:TOPP', 2 )
        Call Lib$Set_Symbol ( 'TY*PE', 'TYPE/PAGE', 2 )
        Call Lib$Set_Symbol ( 'UAF', 'MC AUTHORIZE', 2 )
        Call Lib$Set_Symbol ( 'UNPROT', 
     .          'SET PROT=(S:RWED,O:RWED,G:RE,W:RE)', 2 )
        Call Lib$Set_Symbol ( 'VI', 'EDIT/TPU/SECTION=VI', 2 )
        Call Lib$Set_Symbol ( 'VML', '@SYS$UPDATE:VMSLICENSE', 2 )
        Call Lib$Set_Symbol ( 'VN', 
     .          'VNEWS/HEADER=(FROM,SUBJECT,DATE)/MARK=<', 2 )
        Call Lib$Set_Symbol ( 'VT100', '@SYS$SYSTEM:VT100', 2 )
        Call Lib$Set_Symbol ( 'WATCH', '$EXE:WATCH', 2 )
        Call Lib$Set_Symbol ( 'WATCHFOR', 
     .          'SPAWN/NOWAIT/INPUT=NL:/NOLOG @COM:WATCHFOR', 2 )
        Call Lib$Set_Symbol ( 'WC', '$WORDCOUNT', 2 )
        Call Lib$Set_Symbol ( 'WHY', 'MONITOR/INTERVAL=1 SYSTEM', 2 )
        Call Lib$Set_Symbol ( 'WIPE', '@COM$DIR:WIPE', 2 )
        Call Lib$Set_Symbol ( 'WORK*SET', '$WORKSET', 2 )
        Call Lib$Set_Symbol ( 'XEN', '@SYS$LOGIN:TO XEN', 2 )
        Call Lib$Set_Symbol ( 'Y', 'REPLY/TO=', 2 )
        Call Lib$Set_Symbol ( 'Z*ERR', '$EXE:ZERR', 2 )
        Call Lib$Set_Symbol ( 'W', 'USERS', 2 )
C
C Set up some process privileges
C
        Istat = Sys$Setprv(%val(Enbflg),Priv_Mask,%val(Prmflg),)
        if (.not.Istat) Call Lib$Signal(%val(Istat))
C
C Find out what the process state is and bail out if not interactive
C
        Call Lib$Getjpi(Jpi$_Mode,,,,Mode_State)

        if (Mode_State.ne.'INTERACTIVE') Call exit
C
C Find out when the system was last booted. Also find out when the
C system is going to shutdown (if shutdown in progress)
C
        Call Lib$Sys_Trnlog('SYS$NAME',,Nodename)
        Call Lib$Getsyi(Syi$_Boottime,,Lastboot)

        Write (6,*) Nodename(:index(Nodename,' ')-1),
     .          ' was last booted ',Lastboot

        Call Lib$Sys_Trnlog('SHUTDOWN$TIME',,Nextdown)
        dollar = index(Nextdown,'$')
        if (dollar.eq.0) Write (6,*)
     .          Nodename(:index(Nodename,' ')-1),
     .          ' is going down at ',Nextdown

        Write (6,*) ' '
C
C set the process name. Loop until unique name is found.
C
        ProcessName = 'CTHULU'
        Number = ' '
        Count = 0

        Do while (.not.Pstat)
           Pstat = Sys$Setprn(ProcessName(:index(ProcessName,'  ')-1))
           If (.not.Pstat) then
              ProcessName = 'CTHULU'
              Count = Count + 1
              Call ots$cvt_l_to(Count,CCount)
              Number = '_'//CCount
              ProcessName = ProcessName
     .          (:index(ProcessName,'  ')-1)//Number
           EndIf
        EndDo
C
C Find out the username and set up the prompt
C
        Call Lib$Getjpi(Jpi$_Username,,,,Username)

        If (Number.ne.' ') then
           Prompt = Bold//Whatnode//'_'//Username(:index
     .          (Username,' ')-1)//Number//' >>> '//Normal
        Else
           Prompt = Bold//Whatnode//'_'//Username(:index
     .          (Username,' ')-1)//' >>> '//Normal
        EndIf

        CommandLine = 'SET PROMPT="'//Prompt(:index
     .          (Prompt,'  ')-1)//'"'

        Call Lib$Do_Command(CommandLine)

        End

--------------------------------------------------------------------------------
John Howells           |  "Science does not     | howells@pioneer.arc.nasa.gov
Sterling Software      |   remove the terror    | howells@krypton.arc.nasa.gov
Palo Alto, Ca.         |   of the Gods"         | howells%kry@ames-io.arpa

