.TITLE ALL_MESSAGES .IDENT /V1.02/ ; Find information about mail messages. ; ; A user runs this program, and specifies the name of another user. ; The program should list information about all mail messages ; of the other user. ; ; >>>>>>>>>> NOTE <<<<<<<<< ; ; Some people might consider the ability for one user to read this ; information about another users' mail to be an invasion of ; privacy. You should check your site's policy (if any) about the ; privacy (if any) of users' mail. ; ; It probably will be a good idea not to install it, so not everyone ; can run it. If it is installed it needs SYSNAM and BYPASS, otherwise ; only privileged users can run it; which also means it must be linked ; /NOTRACEBACK. ; ; B. Z. Lederman 02-Sep-1990 $MAILDEF ; for now, must define these $MAILMSGDEF ; at compile time .PSECT MDATA, RD, WRT, LONG, NOEXE USERNAME_LEN = 12 ; could pick up a UAF or other system CONTEXT: ; for USER and MAILFILE .LONG 0 CONTEXT2: ; for MESSAGE .LONG 0 NOSIG_LIST: .WORD 0 .WORD MAIL$_NOSIGNAL ; don't signal errors, program will handle .LONG 0 .LONG 0 NULL_LIST: ; Null item terminates list .WORD 0 ; buffer length .WORD 0 ; item code .LONG 0 ; buffer address .LONG 0 ; return length address (output only) IN_LIST1: .WORD USERNAME_LEN ; will supply user name .WORD MAIL$_USER_USERNAME .ADDRESS USERNAME .LONG 0 .WORD 0 .WORD MAIL$_NOSIGNAL ; don't signal errors .LONG 0 ; program will handle them .LONG 0 .LONG 0, 0, 0 ; Null item terminates list OUT_LIST1: .WORD DIRECT_LEN ; get the directory for the users' .WORD MAIL$_USER_FULL_DIRECTORY ; MAIL.MAI file. .ADDRESS DIRECT .ADDRESS DIRECT_RET .WORD FORW_LEN ; also get forwarding, if any .WORD MAIL$_USER_FORWARDING .ADDRESS FORW .ADDRESS FORW_RET .LONG 0, 0, 0 ; Null item terminates list IN_LIST2: .WORD DIRECT_LEN ; Mail file directory .WORD MAIL$_MAILFILE_DEFAULT_NAME .ADDRESS DIRECT .LONG 0 .WORD 0 .WORD MAIL$_NOSIGNAL .LONG 0 .LONG 0 .LONG 0, 0, 0 IN_LIST3: .WORD 4 ; use length of an address .WORD MAIL$_MAILFILE_FOLDER_ROUTINE .ADDRESS FOLDER_ROUTINE .LONG 0 .WORD 0 .WORD MAIL$_NOSIGNAL .LONG 0 .LONG 0 .LONG 0, 0, 0 IN_LIST4: .WORD 4 ; length of long word .WORD MAIL$_MESSAGE_FILE_CTX .ADDRESS CONTEXT .LONG 0 .WORD 0 .WORD MAIL$_NOSIGNAL .LONG 0 .LONG 0 .LONG 0, 0, 0 IN_LIST5: .WORD FOLDER_LEN ; must have a folder name .WORD MAIL$_MESSAGE_FOLDER .ADDRESS FOLDER .LONG 0 .WORD 0 .WORD MAIL$_NOSIGNAL .LONG 0 .LONG 0 .LONG 0, 0, 0 IN_LIST6: .WORD 0 .WORD MAIL$_MESSAGE_NEXT .LONG 0 .LONG 0 .WORD 0 .WORD MAIL$_NOSIGNAL .LONG 0 .LONG 0 .LONG 0, 0, 0 OUT_LIST6: .WORD SUBJECT_LEN ; retrieve subject of message .WORD MAIL$_MESSAGE_SUBJECT .ADDRESS SUBJECT .ADDRESS SUBJECT_RET .WORD 8 ; length of a date .WORD MAIL$_MESSAGE_BINARY_DATE .ADDRESS BIN_DATE .LONG 0 .LONG 0, 0, 0 USER_DSC: ; descriptor to hold user's name .WORD USERNAME_LEN .BYTE DSC$K_DTYPE_T .BYTE DSC$K_CLASS_S .ADDRESS USERNAME USERNAME: .BLKB USERNAME_LEN DIRECT: ; space to hold mailfile directory .BLKB 64 DIRECT_LEN = .-DIRECT DIRECT_RET: .LONG 0 FORW: .BLKB 64 ; space to hold forwarding string FORW_LEN = .-FORW FORW_RET: ; actual length returned .LONG 0 MAIL_FILE: ; must append this to directory .ASCII /MAIL.MAI/ MAIL_FILE_LEN = .-MAIL_FILE NOUSER_FLAG: .LONG 0 ; selection criteria FOLDER_DSC: ; descriptor to hold name of folder .WORD FOLDER_LEN .BYTE DSC$K_DTYPE_T .BYTE DSC$K_CLASS_S .ADDRESS FOLDER FOLDER: .BLKB 32 ; will fill in folder name later FOLDER_LEN = .-FOLDER FOLDER_RET: ; need real length from STR$TRIM .LONG 0 SUBJECT: ; space to hold subject of message .BLKB 72 SUBJECT_LEN = .-SUBJECT SUBJECT_RET: .LONG 0 BIN_DATE: .BLKQ 1 ; space for one binary date COLON: .ASCID /:/ ; will search for this in forwarding string ; to find forwarding off-node FAODSC: .LONG 80 ; FAO descriptor .ADDRESS FAOBUF ; address of buffer FAOBUF: .BLKB 80 ; FAO buffer FAOLEN: .WORD 0 ; length of initial string .WORD 0 ; need quad value for $QIOW DSCLEN: .WORD 0 ; length (filled in later) .BYTE DSC$K_DTYPE_T .BYTE DSC$K_CLASS_S DSCADR: .ADDRESS DSCADR ; address (filled in later) MSG_DSC: ; output format control used by FAO .ASCID /!AD, !11%D, !AD/ PMPT_DESC: .ASCID /Enter user name: / ; prompt string descriptor FORW_DSC: .ASCID /Forwarding to: !AD/ FORW_OFF: .ASCID /Can't follow messages to another node./ RESULT_LEN: ; length returned from LIB$GET_FOREIGN .WORD 0 ; Program starts here. .PSECT MCODE, RD, NOWRT, LONG, EXE .ENTRY ALL_MAIL, ^M ; Check to see if the program was invoked with a parameter PUSHAW RESULT_LEN ; returned command length PUSHL #0 ; no prompt PUSHAQ USER_DSC ; string where command will go CALLS #3, G^LIB$GET_FOREIGN ; get a command line JSB ERROR ; check for errors TSTW RESULT_LEN ; was there a command line? BEQL GET_SENT_TO ; branch if not, must prompt for one MOVW RESULT_LEN, USER_DSC ; make sure user set to real length BRB CHECK_SENT ; and and process it .ALIGN LONG GET_SENT_TO: ; get another command TSTW RESULT_LEN ; was this invoked with a command? BNEQ 10$ ; if yes, don't repeat process CLRL FORW_RET ; clear forwarding flag/length MOVW #USERNAME_LEN, USER_DSC ; reset length of input string. PUSHAW USER_DSC ; Length of input string. PUSHAL PMPT_DESC ; Descriptor for prompt string. PUSHAL USER_DSC ; Descriptor for input string. CALLS #3, G^LIB$GET_INPUT ; get input from user CMPL R0, #SS$_NORMAL ; was it o.k.? BEQL CHECK_SENT ; branch if o.k. CMPL R0, #RMS$_EOF ; was is EOF (Control-Z)? BNEQ 10$ ; branch if not BISL #1, R0 ; change EOF to 'success' status 10$: $EXIT_S R0 ; Exit from program .ALIGN LONG CHECK_SENT: CALLS #0, RECEIVER_ROUTINE ; print out info on this receiver TSTW FORW_RET ; was there a forwarding string? BEQL GET_SENT_TO ; no, go back and repeat process ; user has set forwarding, we can't follow it, tell the user CVTWL FORW_RET, FORW_RET ; need longword for $FAO ; $FAO_S - ; format message CTRSTR = FORW_DSC, - OUTLEN = FAOLEN, - OUTBUF = FAODSC, - P1 = FORW_RET, - ; length of string P2 = #FORW ; address of forwarding name JSB ERROR ; check for errors MOVW FAOLEN, DSCLEN ; output message MOVAL FAOBUF, DSCADR PUSHAQ DSCLEN CALLS #1, G^LIB$PUT_OUTPUT JSB ERROR ; check for errors PUSHAB FORW ; address of forwarding string PUSHAW FORW_RET ; address of length of string PUSHAL USER_DSC ; address of username descript. CALLS #3, G^STR$COPY_R ; move forwarding to username CMPL R0, #STR$_TRU ; did we get truncate on copy? BEQL OFFNODE ; branch if yes, forwarded off node JSB ERROR ; check results for other errors PUSHAL COLON ; descriptor containing ":" PUSHAL USER_DSC ; descriptor with username CALLS #2, G^STR$POSITION ; check for colon in username TSTW R0 ; was there a colon? BNEQ OFFNODE ; branch if yes, can't check remote BRW CHECK_SENT ; check mail to this recipient .ALIGN LONG OFFNODE: PUSHAQ FORW_OFF ; forwarding off node CALLS #1, G^LIB$PUT_OUTPUT ; output fixed message JSB ERROR ; check for errors BRW GET_SENT_TO ; and repeat process .ALIGN LONG ; Routine to process recipient's mail file .ENTRY RECEIVER_ROUTINE, ^M<> ; process receiver by name CLRL NOUSER_FLAG MOVW USER_DSC, IN_LIST1 ; move real length to item list PUSHAL NULL_LIST PUSHAL NOSIG_LIST PUSHAL CONTEXT CALLS #3, G^MAIL$USER_BEGIN ; initialize mail access JSB ERROR ; check for errors PUSHAL OUT_LIST1 ; get information on user PUSHAL IN_LIST1 ; (specifically, location of PUSHAL CONTEXT ; their mail file) CALLS #3, G^MAIL$USER_GET_INFO ; Check for 'no such user' message CMPL R0, #MAIL$_NOSUCHUSR ; did we get 'no such user'? BEQL 110$ ; yes, do special processing JSB ERROR ; check for other errors BRB 120$ ; if o.k., continue processing .ALIGN LONG 110$: DECL NOUSER_FLAG ; set flag for later TSTW RESULT_LEN ; were we invoked with command? BNEQ 120$ ; don't signal, will exit with status PUSHAQ USER_DSC ; who we tried to look for PUSHL #1 ; one arg PUSHL # ; push error value and 'warning' CALLS #3, G^LIB$SIGNAL ; signal error 120$: PUSHAL NULL_LIST ; finished this part of mail access PUSHAL NULL_LIST PUSHAL CONTEXT CALLS #3, G^MAIL$USER_END JSB ERROR ; check for errors TSTL NOUSER_FLAG ; did we have a 'no such user' error? BEQL 140$ ; branch if not TSTW RESULT_LEN ; were we invoked with a command? BNEQ 130$ ; branch if yes, will exit RET ; otherwise return to caller .ALIGN LONG 130$: PUSHAQ USER_DSC ; who we tried to look for PUSHL #1 ; one arg PUSHL #MAIL$_NOSUCHUSR ; error value CALLS #3, G^LIB$STOP ; signal error and stop program .ALIGN LONG 140$: MOVAB DIRECT, R6 ; get address of directory ADDL DIRECT_RET, R6 ; add length of directory MOVC3 #MAIL_FILE_LEN, MAIL_FILE, (R6) ; add MAIL.MAI to directory ADDL #MAIL_FILE_LEN, DIRECT_RET ; fix length CVTLW DIRECT_RET, IN_LIST2 ; store new file spec length PUSHAL NULL_LIST ; begin access of mail file PUSHAL NOSIG_LIST PUSHAL CONTEXT CALLS #3, G^MAIL$MAILFILE_BEGIN JSB ERROR PUSHAL NULL_LIST ; open mail file PUSHAL IN_LIST2 PUSHAL CONTEXT CALLS #3, G^MAIL$MAILFILE_OPEN JSB ERROR PUSHAL NULL_LIST ; get information from PUSHAL IN_LIST3 ; mail file (folder names) PUSHAL CONTEXT CALLS #3, G^MAIL$MAILFILE_INFO_FILE ; The above call doesn't return until all folders have been ; processed; so when we get here there's nothing left to do ; but clean up and leave. JSB ERROR ; check for error PUSHAL NULL_LIST ; close mail file PUSHAL NULL_LIST PUSHAL CONTEXT CALLS #3, G^MAIL$MAILFILE_CLOSE JSB ERROR ; check for error PUSHAL NULL_LIST ; finish mail access PUSHAL NULL_LIST PUSHAL CONTEXT CALLS #3, G^MAIL$MAILFILE_END JSB ERROR ; check for error RET ; done with receiver routine .ALIGN LONG ; Routine to check contents of a folder .ENTRY FOLDER_ROUTINE, ^M<> ; process folders IFOLD_DESC = 8 ; second argument on list is ; descriptor with folder name CMPL R0, #SS$_NORMAL ; results o.k.? BEQL 20$ ; branch if o.k. CMPL R0, #RMS$_RNF ; no more folders? BEQL 10$ ; branch if yes JSB ERROR ; test for other errors 10$: RET ; finished, return to caller .ALIGN LONG 20$: PUSHAW IN_LIST5 ; address of returned length PUSHL IFOLD_DESC(AP) ; address of input descriptor PUSHAQ FOLDER_DSC ; address of local copy CALLS #3, G^STR$TRIM ; copy with trailing blank trim CMPL R0, #SS$_NORMAL ; did it work? BEQL 30$ ; branch if yes JSB ERROR ; indicate error RET ; return .ALIGN LONG 30$: TSTW IN_LIST5 ; check length of input string BNEQ 40$ ; branch if we have something to process RET ; otherwise done, return to caller .ALIGN LONG ; Go through messages in this folder 40$: PUSHAL NULL_LIST ; start message access PUSHAL IN_LIST4 PUSHAL CONTEXT2 CALLS #3, G^MAIL$MESSAGE_BEGIN JSB ERROR PUSHAL NULL_LIST ; select the first message PUSHAL IN_LIST5 PUSHAL CONTEXT2 CALLS #3, G^MAIL$MESSAGE_SELECT JSB ERROR MESSAGE_LOOP: PUSHAL OUT_LIST6 ; get message information PUSHAL IN_LIST6 ; (subject) PUSHAL CONTEXT2 CALLS #3, G^MAIL$MESSAGE_INFO CMPL #MAIL$_NOMOREMSG, R0 ; was it "end of data"? BEQL 30$ ; branch if yes, no more data JSB ERROR ; test for other errors CVTWL IN_LIST5, FOLDER_RET ; need longword for $FAO ; $FAO_S - ; format message CTRSTR = MSG_DSC, - OUTLEN = FAOLEN, - OUTBUF = FAODSC, - P1 = FOLDER_RET, - ; length of folder string P2 = #FOLDER, - ; address of folder string P3 = #BIN_DATE, - ; address of date P4 = SUBJECT_RET, - ; length of subject string P5 = #SUBJECT ; address of subject string JSB ERROR ; check for errors MOVW FAOLEN, DSCLEN ; output information MOVAL FAOBUF, DSCADR PUSHAQ DSCLEN CALLS #1, G^LIB$PUT_OUTPUT JSB ERROR ; check for errors BRW MESSAGE_LOOP ; get next message .ALIGN LONG 30$: PUSHAL NULL_LIST ; finish message access PUSHAL NULL_LIST PUSHAL CONTEXT2 CALLS #3, G^MAIL$MESSAGE_END JSB ERROR RET ; return to folder loop .ALIGN LONG ; Error Checking Routine ERROR: BLBC R0, 10$ ; if error, branch RSB ; otherwise, continue with program 10$: RET ; let the system output any ; error messages .END ALL_MAIL