$! X-NEWS: acfclu vmsnet.sources: 408 $! Path: cmcl2!phri!rutgers!uwm.edu!spool2.mu.edu!sdd.hp.com!ucsd!casbah.acns.nwu.edu!hayes.ims.alaska.edu!milton!sumax!quick!innovative.com!jw $! From: jw@innovative.com $! Newsgroups: vmsnet.sources $! Subject: MAILQ, Part 1 of 1 $! Message-ID: <1991Jan29.192935.1268@innovative.com> $! Date: 30 Jan 91 03:29:35 GMT $! Organization: Innovative Software, Seattle, WA, USA $! Lines: 388 $! $! MAILQ is a utility to examine the queue of mail requests on a DECUS UUCP $! system. MAILQ helps users to track the status of their incoming or $! outbound mail while it's being processed on the local system. It is $! similar in function to the "mailq" and "sendmail -bp" commands, which $! are used to examine sendmail's queue on BSD-based UNIX systems. $! $! Regards, $! Jay Whitney $! -- $! Internet: jw@innovative.com Innovative Software $! UUCP: {uunet,rutgers}!innsoft!jw Seattle, Washington $! $! $! --------------------------- CUT HERE --------------------------- $ v='f$verify(f$trnlnm("SHARE_VERIFY"))' $! $! This archive created by VMS_SHARE Version 7.2-007 22-FEB-1990 $! On 14-JAN-1991 22:55:47.37 By user JW $! $! This VMS_SHARE Written by: $! Andy Harper, Kings College London UK $! $! Acknowledgements to: $! James Gray - Original VMS_SHARE $! Michael Bednarek - Original Concept and implementation $! $! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER $! AND EXECUTE AS A COMMAND PROCEDURE ( @name ) $! $! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING: $! 1. BUILD.COM;1 $! 2. MAILQ.FOR;1 $! 3. README.;1 $! $set="set" $set symbol/scope=(nolocal,noglobal) $f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID")) $e="write sys$error ""%UNPACK"", " $w="write sys$output ""%UNPACK"", " $ if f$trnlnm("SHARE_LOG") then $ w = "!" $ ve=f$getsyi("version") $ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START $ e "-E-OLDVER, Must run at least VMS 4.4" $ v=f$verify(v) $ exit 44 $UNPACK: SUBROUTINE ! P1=filename, P2=checksum $ if f$search(P1) .eqs. "" then $ goto file_absent $ e "-W-EXISTS, File ''P1' exists. Skipped." $ delete 'f'* $ exit $file_absent: $ if f$parse(P1) .nes. "" then $ goto dirok $ dn=f$parse(P1,,,"DIRECTORY") $ w "-I-CREDIR, Creating directory ''dn'." $ create/dir 'dn' $ if $status then $ goto dirok $ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped." $ delete 'f'* $ exit $dirok: $ w "-I-PROCESS, Processing file ''P1'." $ if .not. f$verify() then $ define/user sys$output nl: $ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1' PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET( SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:= CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b)); LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION( BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1); IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE; MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1; ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")= 1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF"; POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r); ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1; COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE, "output_file"));ENDPROCEDURE;Unpacker;QUIT; $ delete/nolog 'f'* $ CHECKSUM 'P1' $ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT $ e "-E-CHKSMFAIL, Checksum of ''P1' failed." $ ENDSUBROUTINE $START: $ create 'f' X$ fortran/optimize/nodebug/extend_source mailq X$ link/notraceback/nodebug mailq X$ exit $ CALL UNPACK BUILD.COM;1 1769611355 $ create 'f' Xc--------------------------------------------------------------------------- V- Xc----- MAILQ - v1.0 (C) 1990, Jay Whitney and Innovative Software ---- V- Xc--------------------------------------------------------------------------- V- Xc----- MAILQ is a utility to examine the queue of mail requests on a ---- V- Xc----- UUCP node. ---- V- Xc----- ---- V- Xc----- The copyright holders retain ownership of this package, and ---- V- Xc----- hereby permit its use and distribution with the provisions that ---- V- Xc----- it is not used or incorporated in a commercial software package, ---- V- Xc----- and that this notice is placed unaltered into all copies. ---- V- Xc----- ---- V- Xc----- The copyright holders cannot be held responsible or liable for ---- V- Xc----- any loss or damage caused by (mis)use of this software. ---- V- Xc----- ---- V- Xc----- Use of this software constitutes acceptance of these terms. ---- V- Xc--------------------------------------------------------------------------- V- X program mailq X implicit integer (a-z) X X character*255 file X character*80 node X character*80 header_line X character*80 blank_line X character*8 sequence X character*255 mail_line X character*255 to X character*255 from X character*255 date X character*37 preface X character*20 name X X logical to_found X logical from_found X logical from_start_found X logical from_end_found X logical date_found X logical news_found X X external rms$_nmf X external rms$_fnf X X X found = 0 X X 10 call sysprv_on X X status = lib$find_file ('D', file, context, 'UUCP_SPOOL:*.*;',,,) X X if (.not. status) then X call sysprv_off X X if (status .eq. %loc(rms$_fnf)) then X call lib$put_output ('Mail queue is empty') X call exit X elseif (status .eq. %loc(rms$_nmf)) then X if (found .eq. 0) then X call lib$put_output ('Mail queue is empty') X end if X call lib$find_file_end (context) X call exit X else X call lib$stop (%val(status)) X end if X else X open (unit=1, file=file, status='OLD', readonly, shared, err=10) X X call sysprv_off X X from_found = .false. X to_found = .false. X date_found = .false. X news_found = .false. X end if X X tables = 6 ! lnm$system only X call lib$sys_trnlog ('UUCP_HOST_NAME', node_l, node,,, tables) X X search_start = str$position(file, '`5DD',) X X seq_start = str$position (file, '_', search_start) X seq_end = str$position (file, ';', search_start) - 1 X if (seq_start .eq. 0) then`20 X seq_start = seq_end - 3 X else X seq_start = seq_start + 2 X endif X X sequence = file(seq_start:seq_end) X sequence_l = seq_end - seq_start + 1 X X do pos = 1, sequence_l X if (sequence(pos:pos) .eq. '_') then X sequence(pos:) = sequence(pos + 1:) X sequence_l = sequence_l - 1 X end if X end do X X name_start = str$position (file, '.', search_start) + 1 X name_end = str$position (file, '_', search_start) X if (name_end .eq. 0) then`20 X name_end = seq_end - 4 X else X name_end = name_end - 1 X end if X X name = file(name_start:name_end) X name_l = name_end - name_start + 1 X X 20 read (1, '(q, a)', end=30, err=30) mail_line_l, mail_line X X if (mail_line(:11) .eq. '#! cunbatch') then X news_found = .true. X goto 30 X X elseif ((mail_line(:4) .eq. 'To: ') .and. (.not. to_found)) then X to_found = .true. X to = mail_line(5:mail_line_l) X to_l = mail_line_l - 4 X X elseif ((mail_line(:6) .eq. 'From: ') .and. (.not. from_found)) then X from_found = .true. X from_start_found = .false. X from_end_found = .false. X X do pos = 7, mail_line_l X if (mail_line(pos:pos) .eq. '<') then X from_start = pos + 1 X from_start_found = .true. X elseif (mail_line(pos:pos) .eq. '>') then X from_end = pos - 1 X from_end_found = .true. X end if X end do X X if (from_start_found .and. from_end_found) then X from = mail_line(from_start:from_end) X from_l = from_end - from_start + 1 X else X from = mail_line(7:mail_line_l) X from_l = mail_line_l - 6 X end if X X from_end = str$position(from(:from_l), ' ') X if (from_end .ne. 0) then X from = from(:from_end - 1) X from_l = from_end - 1 X end if X X elseif ((mail_line(:6) .eq. 'Date: ') .and. (.not. date_found)) then X date_found = .true. X date = mail_line(7:mail_line_l) X date_l = mail_line_l - 6 X X end if X X if (from_found .and. to_found .and. date_found) goto 30 X X goto 20 X X 30 close (unit=1) X X found = found + 1 X X if (found. eq. 1) then X header_line = 'Listing of mail queue on UUCP node '//node X header_line_l = 35 + node_l X blank_line = ' ' X blanks = (80 - header_line_l) / 2 - 1 X call lib$put_output(blank_line(:blanks)//header_line(:header_line_l) V) X end if X X if (news_found) then X date = ' ' X preface = sequence(:6)//' '//date X call lib$put_output (preface//'Compressed News transfer with '// X $ name(:name_l)) X elseif (from_found .and. to_found .and. date_found) then X preface = sequence(:6)//' '//date X call lib$put_output (preface//from(:from_l)) X X preface = ' ' X`09call lib$put_output (preface//to(:to_l)) X else X date = ' ' X preface = sequence(:6)//' '//date X call lib$put_output (preface//'(parse inconclusive)') X end if X X goto 10 X X end X X Xc--------------------------------------------------------------------------- V-- Xc----- This routine enables SYSPRV, if it is available --- V-- Xc--------------------------------------------------------------------------- V-- X subroutine sysprv_on X implicit integer (a-z) X X include '($prvdef)' X X integer*4 priv_mask(2) X X X priv_mask(1) = prv$m_sysprv X priv_mask(2) = 0 X X status = sys$setprv (%val(1), priv_mask, %val(0), ) X if (.not.status) call sys$exit(%val(status)) X X return X X end X Xc--------------------------------------------------------------------------- V-- Xc----- This routine disables SYSPRV --- V-- Xc--------------------------------------------------------------------------- V-- X subroutine sysprv_off X implicit integer (a-z) X X integer*4 priv_mask(2) X`20 X include '($prvdef)' X X X priv_mask(1) = prv$m_sysprv X priv_mask(2) = 0 X X status = sys$setprv (%val(0), priv_mask, %val(0), ) X if (.not.status) call sys$exit(%val(status)) X X return X X end $ CALL UNPACK MAILQ.FOR;1 1377962598 $ create 'f' XMAILQ is a utility to examine the queue of mail requests on a DECUS UUCP Xsystem. MAILQ helps users to track the status of their incoming or Xoutbound mail while it's being processed on the local system. It is Xsimilar in function to the "mailq" and "sendmail -bp" commands, which Xare used to examine sendmail's queue on BSD-based UNIX systems. X XIt works by searching the UUCP_SPOOL directory for D files, which are UUCP Xtransfer data files. It then parses the files, looking for "To:" and X"From:" lines in the header. It is also capable of detecting compressed XNews batches. It does not identify uncompressed news batches or file Xtransfers initiated with the UUCP command (in part because we are only Xrunning DECUS UUCP V1.1.). If someone would care to share features of Xthese kinds of D files, I'll parse those as well. X XMAILQ requires VAX FORTRAN for compilation (If you don't have VAX FORTRAN, Xsend me mail, and I'll send you an MFTUed object file as soon as I can).`20 XCompile and link it using the trivial BUILD.COM procedure provided. X XThe image file MAILQ.EXE should be placed in UUCP_BIN, and the line X XMAILQ :== $UUCP_BIN:MAILQ X Xshould be added to UUCP_BIN:USERCMDS.COM, so that users may use this Xutility. X XSince the UUCP_SPOOL directory should not be world readable, you need to Xinstall the image if you wish other users to be able to examine the queue.`2 V0 XOtherwise, only users with SYSPRV or who otherwise have access to XUUCP_SPOOL will be able to examine the queue. The privilege is used as Xjudiciously as can be, and is disabled when not needed. `20 X XThe relevant install command is: X XADD UUCP_BIN:MAILQ/OPEN/HEADER/SHARE/PRIV=SYSPRV X Xand should be included in UUCP_SYSTARTUP.COM if you wish it to be installed Xfor each system startup. $ CALL UNPACK README.;1 1484722600 $ v=f$verify(v) $ EXIT