OpenVMS Source Code Demos
LOGIN_HELPER.COM
$ set noon !
$ set nover !
$!====================================================================
$! title : csmis_ict_ftp:login_helper.com
$! author : Neil Rieck
$! created : 2008.06.19
$! edit : 2011.08.02
$! function:
$! 1. we are trying to emulate an XCOM session (run a job on logout)
$! 2. an FTP/SFTP connection event submits this job
$! 3. the FTP/SFTP client then passes files to the [.data] folder
$! 4. this job loops until the FTP/SFTP client logs off
$! 5. then we process the received file(s)
$!====================================================================
$ set ver !
$ bel[0,8]=7 !
$ my_debug=1 !
$ say :== write sys$output !
$!
$ say "-i-scrp: ", f$environment("PROCEDURE") !
$ sho def ! where are we right now?
$ if f$mode() .nes. "BATCH" then goto sortie !
$ if p1 .eqs. "" ! name of the queueing process
$ then !
$ say "-e- no P1, aborting" !
$ goto sortie !
$ endif !
$ if p2 .eqs. "" ! pid of the queueing process
$ then !
$ say "-e- no P2, aborting" !
$ goto sortie !
$ endif !
$ say "-i-parameter 1: ",p1 ! name of the queueing process
$ say "-i-parameter 2: ",p2 ! pid of the queueing process
$!
$ on error then goto sortie ! prep for name change/test
$ set on ! enable error handling...
$ set proc/name="IctHelper" ! ...cuz we only want one of these
$ set noon ! ...now disable error handling
$!--------------------------------------------------------------
$! Wait here until the network partner disconnects, or 60 seconds passes
$!--------------------------------------------------------------
$start_count: !
$ my_loop = 1 ! init
$wait_loop: !
$ if my_debug .gt. 0 !
$ then !
$ say "==========" !
$ say "-i-loop ",my_loop !
$ sh sys/net/bat !
$ endif !
$!
$! see if the target process is still on the system
$!
$ on warning then goto process_files ! jump if warning on next test (he's gone)
$ junk = f$getjpi(my_pid,"PRCNAM") ! is our process still on the system?
$ on error then goto sortie ! something horrible has gone wrong
$!
$! he is still logged in so do som more testing
$!
$ if junk .nes. p1 then goto process_files ! jump if wrong name (pid already reissued?)
$ wait 0:0:10 ! pause for 10 seconds
$ my_loop = my_loop + 1 !
$ if my_loop .lt. 6 then goto wait_loop ! loop if we haven't waited for 60 sec
$ say "-i-looped for 60 seconds so exiting" !
$!====================================================================
$! The FTP client has disconnected so let's process the received files
$!====================================================================
$process_files: !
$ set noon ! no stopping now...
$ my_node = f$getsyi("nodename") !
$ pur/log/noco *.txt !
$ del/log *.tmp;* !
$ if f$mode() .eqs. "INTERACTIVE" then del/sym/glo mail !
$ if my_node .eqs. "KAWC09" !
$ then
$ dir/width=(display=100,file=50)/nohead/notrail/output=listing.tmp [.ACCEPTATION]BRT2*.txt
$ else
$ dir/width=(display=100,file=50)/nohead/notrail/output=listing.tmp [.ATS]BRT2*.txt
$ endif
$ open/read/error=my_error my_file listing.tmp !
$read_loop: !
$ read/end_of_file=my_error my_file my_buffer !
$!~~~ my_dev = f$parse(my_buffer,,,"DEVICE") !
$!~~~ my_dir = f$parse(my_buffer,,,"DIRECTORY") !
$!~~~ my_name = f$parse(my_buffer,,,"NAME") ! yields something like: "AK123400" where 00 is a version number)
$!~~~ my_type = f$parse(my_buffer,,,"TYPE") ! yields: ".TXT"
$!~~~ my_arch = f$extract(f$length(my_name)-3,1,my_name) ! get last digit of order number (but skipping version number)
$ pos% = f$locate(";",my_buffer) !
$ my_fs1 = f$extract(0,pos%,my_buffer) !
$!~~~ my_fs1 = my_dir + my_name + my_type !
$ mail/subj="ICT-from-login-helper.com" 'my_fs1' neil ! for debug purposes
$ def/proc CSMIS$ICT_FTP_INBOUND_FILE_INPUT 'my_fs1' !
$ wait 0:0:01 !
$ stamp = f$cvtime() ! eg. 2008-07-07 09:32:12.88
$ stamp = stamp -"-" -"-" -" " -":" -":" -"." ! eg. 2008070709321288
$ my_fs2 = f$trnlnm("CSMIS_ICT_FTP")+"ICT"+ f$extract(0,14,stamp) +".XML"
$ def/proc CSMIS$ICT_FTP_INBOUND_FILE_OUTPUT 'my_fs2' !
$ r csmis$exe:TRODB_FROM_SYSTEM5.EXE ! run this program
$ saved_status = $STATUS !
$ say "status: ", saved_status !
$ if ((saved_status .and. 7) .ne. 1) !
$ then !
$ say "-e-oops, something failed" !
$ else !
$ say "-e-yipee, processing was sucessful" !
$ endif !
$ ren/log 'my_fs1' [.archive] ! move this file to the archive below ftp.data
$ yada = f$trnlnm("CSMIS_ICT_FTP") -"]" +"._archive]" !
$ ren/log 'my_fs2' 'yada' ! move this file to the archive below sys$login
$ goto read_loop !
$my_error: !
$ close my_file !
$ pur/log/noco/keep=10 *.log !
$sortie: !
$ set noon !
$ del [...]brt20*.*;*/before="-7-0:0:0"/log !
$!------------------------------------------------------------------------------------
$! <<< do a little purging here >>>
$!
$! notes: 1) the current user may not have sufficient privs
$! 2) this is a quick hack which will need a future cleanup
$! 3) should introduce some code so we only do this once per day
$!
$ say f$getjpi("","USERNAME") !
$ del/log DISK$USER4:[CSMIS.CSMIS_ICT_FTP._ARCHIVE]ict20*.*;*/before="-7-0:0:0"
$!------------------------------------------------------------------------------------
$ exit !