| 1 | XMXSEC2 ;ISC-SF/GMB-Message security and restrictions (cont.) ;04/18/2002 08:01
|
|---|
| 2 | ;;8.0;MailMan;;Jun 28, 2002
|
|---|
| 3 | ; All entry points covered by DBIA 2733.
|
|---|
| 4 | EDIT(XMDUZ,XMZ,XMZREC) ; May the user edit the message? (1=may, 0=may not)
|
|---|
| 5 | I '$$ORIGIN8R^XMXSEC(XMDUZ,.XMZREC) D ERRSET^XMXUTIL(37405.1) Q 0 ; Only the originator may Edit a message.
|
|---|
| 6 | I $P($G(^XMB(3.9,XMZ,1,0)),U,4)>1!($P(XMZREC,U,2)'=$O(^XMB(3.9,XMZ,1,"C",0))) D ERRSET^XMXUTIL(37405.2) Q 0 ; You may not Edit a message you have already sent to someone else.
|
|---|
| 7 | I $O(^XMB(3.9,XMZ,3,0)) D ERRSET^XMXUTIL(37405.3) Q 0 ; You may not Edit a message which has a reply.
|
|---|
| 8 | I $D(^XMB(3.9,XMZ,"K")),XMINSTR("TYPE")["X"!(XMINSTR("TYPE")["K") D ERRSET^XMXUTIL(37405.4) ; You may not Edit a secure KIDS or PackMan message.
|
|---|
| 9 | Q 1
|
|---|
| 10 | OPTEDIT(XMINSTR,XMOPT,XMOX,XMQDNUM) ; We know the user may edit the message.
|
|---|
| 11 | ; Now, what, exactly, may be edited?
|
|---|
| 12 | D SET("C",$S($G(XMINSTR("FLAGS"))["C":37302,1:37301),.XMOPT,.XMOX) ; UnConfidential (surrogate may read) / Confidential (surrogate can't read)
|
|---|
| 13 | D SET("D",$S($D(XMINSTR("RCPT BSKT")):37304,1:37303),.XMOPT,.XMOX) ; Delivery basket remove / Delivery basket set
|
|---|
| 14 | D SET("I",$S($G(XMINSTR("FLAGS"))["I":37308,1:37307),.XMOPT,.XMOX) ; UnInformation only / Information only
|
|---|
| 15 | D SET("NS",37309,.XMOPT,.XMOX) ; Add Network Signature
|
|---|
| 16 | D SET("P",$S($G(XMINSTR("FLAGS"))["P":37312,1:37311),.XMOPT,.XMOX) ; Normal delivery / Priority delivery
|
|---|
| 17 | D SET("R",$S($G(XMINSTR("FLAGS"))["R":37314,1:37313),.XMOPT,.XMOX) ; No Confirm receipt / Confirm receipt
|
|---|
| 18 | D SET("ES",37305,.XMOPT,.XMOX) ; Edit Subject
|
|---|
| 19 | D SET("ET",37306,.XMOPT,.XMOX) ; Edit Text
|
|---|
| 20 | D SET("V",$S($G(XMINSTR("VAPOR")):37318,1:37317),.XMOPT,.XMOX) ; Vaporize date remove / Vaporize date set
|
|---|
| 21 | D SET("X",$S($G(XMINSTR("FLAGS"))["X":37320,1:37319),.XMOPT,.XMOX) ; UnClose (forward allowed) / Closed (no forward allowed)
|
|---|
| 22 | D SET("S",$S($D(^XMB(3.9,XMZ,"K")):37316,$D(XMINSTR("SCR KEY")):37316,1:37315),.XMOPT,.XMOX) ; UnScramble / Scramble message text
|
|---|
| 23 | I $G(XMPAKMAN)!($G(XMINSTR("TYPE"))["X")!($G(XMINSTR("TYPE"))["K") D
|
|---|
| 24 | . D Q("NX",37309.4) ; You may not add a Network Signature to a KIDS or PackMan message.
|
|---|
| 25 | . D Q("S",37315.4) ; Sorry, but we can't (un)secure a KIDS or PackMan message here.
|
|---|
| 26 | I '$D(XMOPT("NS","?")),'$$GOTNS^XMVVITA(XMDUZ) D
|
|---|
| 27 | . ; pgmr note: this must be the last place that sets XMOPT("NS","?").
|
|---|
| 28 | . I XMDUZ=DUZ D Q("NS",37309.1) Q ; You have no Network Signature.
|
|---|
| 29 | . S XMOPT("NS","?")=$$EZBLD^DIALOG(37309.3,XMV("NAME")) ; |1| has no Network Signature.
|
|---|
| 30 | I $D(^TMP("XMY",$J,.6)) D
|
|---|
| 31 | . D Q("C",37301.6) ; Messages addressed to SHARED,MAIL may not be 'Confidential'.
|
|---|
| 32 | . D Q("X",37320.6) ; Messages addressed to SHARED,MAIL may not be 'Closed'.
|
|---|
| 33 | Q
|
|---|
| 34 | SET(XMCD,XMDN,XMOPT,XMOX) ;
|
|---|
| 35 | N XMDREC
|
|---|
| 36 | S XMDREC=$$EZBLD^DIALOG(XMDN)
|
|---|
| 37 | S XMOPT(XMCD)=$P(XMDREC,":",2,99)
|
|---|
| 38 | S XMOX("O",XMCD)=$P(XMDREC,":",1) ; "O"=original english to foreign
|
|---|
| 39 | S XMOX("X",$P(XMDREC,":",1))=XMCD ; "X"=translate foreign to english
|
|---|
| 40 | Q
|
|---|
| 41 | Q(XMCD,XMDN) ;
|
|---|
| 42 | I $G(XMQDNUM) S XMOPT(XMCD,"?")=XMDN Q
|
|---|
| 43 | S XMOPT(XMCD,"?")=$$EZBLD^DIALOG(XMDN)
|
|---|
| 44 | Q
|
|---|
| 45 | OPTMSG(XMDUZ,XMK,XMZ,XMIM,XMINSTR,XMIU,XMOPT,XMOX,XMQDNUM) ; The user has access to the message. Now what may the user do with it?
|
|---|
| 46 | ; in:
|
|---|
| 47 | ; XMDUZ = the user
|
|---|
| 48 | ; XMK = basket IEN if message is in a basket
|
|---|
| 49 | ; = ! if super search (option XM SUPER SEARCH)
|
|---|
| 50 | ; = 0 otherwise
|
|---|
| 51 | ; XMZ = the message IEN
|
|---|
| 52 | ; The following are set by INMSG1 and INMSG2^XMXUTIL2
|
|---|
| 53 | ; XMIM("FROM") = piece 2 of the message's zero node
|
|---|
| 54 | ; XMINSTR = special instructions
|
|---|
| 55 | ; XMIU("ORIGN8")=
|
|---|
| 56 | ; XMIU("IEN") = the user's IEN in the message's recipient multiple
|
|---|
| 57 | ; XMQDNUM = 0 - set XMOPT(<opt>,"?")=dialog text (default)
|
|---|
| 58 | ; 1 - set XMOPT(<opt>,"?")=dialog number (all are TYPE: ERROR)
|
|---|
| 59 | ; FYI, XMOPT(<opt>,"?") is displayed in SHOWERR^XMJDIR.
|
|---|
| 60 | ; out:
|
|---|
| 61 | ; XMOPT(<opt>) Possible options
|
|---|
| 62 | ; '$D(XMOPT(<opt>,"?")) User may do these things.
|
|---|
| 63 | ; $D(XMOPT(<opt>,"?")) User may NOT do these things.
|
|---|
| 64 | N XMSECPAK
|
|---|
| 65 | I $D(^XMB(3.9,XMZ,"K")),XMINSTR("TYPE")["X"!(XMINSTR("TYPE")["K") S XMSECPAK=1 ; secure packman
|
|---|
| 66 | E S XMSECPAK=0
|
|---|
| 67 | K XMOPT,XMOX
|
|---|
| 68 | D SET("B",37441,.XMOPT,.XMOX) ; Backup
|
|---|
| 69 | D SET("I",37442,.XMOPT,.XMOX) ; Ignore
|
|---|
| 70 | D SET("P",37416,.XMOPT,.XMOX) ; Print
|
|---|
| 71 | D SET("Q",37417,.XMOPT,.XMOX) ; Query
|
|---|
| 72 | D SET("QC",37431,.XMOPT,.XMOX) ; Query Current
|
|---|
| 73 | D SET("QD",37418,.XMOPT,.XMOX) ; Query Detailed
|
|---|
| 74 | D SET("QN",37419,.XMOPT,.XMOX) ; Query Network
|
|---|
| 75 | D SET("QNC",37432,.XMOPT,.XMOX) ; Query Not Current
|
|---|
| 76 | D SET("QR",37420,.XMOPT,.XMOX) ; Query Recipients
|
|---|
| 77 | D SET("QT",37433,.XMOPT,.XMOX) ; Query Terminated
|
|---|
| 78 | Q:XMK="!"
|
|---|
| 79 | D SET("A",37401,.XMOPT,.XMOX) ; Answer
|
|---|
| 80 | D SET("AA",37402,.XMOPT,.XMOX) ; Access Attachments
|
|---|
| 81 | D SET("C",37403,.XMOPT,.XMOX) ; Copy
|
|---|
| 82 | D SET("D",37404,.XMOPT,.XMOX) ; Delete
|
|---|
| 83 | D SET("E",37405,.XMOPT,.XMOX) ; Edit
|
|---|
| 84 | D SET("F",37406,.XMOPT,.XMOX) ; Forward
|
|---|
| 85 | D SET("IN",$S($G(XMINSTR("FLAGS"))["I":37409,1:37408),.XMOPT,.XMOX) ; UnInformation only / Information only
|
|---|
| 86 | D SET("H",37407,.XMOPT,.XMOX) ; Headerless Print
|
|---|
| 87 | D SET("K",$S($G(XMINSTR("FLAGS"))["K":37412,1:37411),.XMOPT,.XMOX) ; UnPriority replies / Priority replies
|
|---|
| 88 | D SET("L",37413,.XMOPT,.XMOX) ; Later
|
|---|
| 89 | D SET("N",$S($G(XMINSTR("FLAGS"))["N":37415,1:37414),.XMOPT,.XMOX) ; UnNew / New
|
|---|
| 90 | D SET("R",37422,.XMOPT,.XMOX) ; Reply
|
|---|
| 91 | D SET("S",37423,.XMOPT,.XMOX) ; Save
|
|---|
| 92 | D SET("T",37424,.XMOPT,.XMOX) ; Terminate
|
|---|
| 93 | D SET("V",37425,.XMOPT,.XMOX) ; Vaporize date edit
|
|---|
| 94 | D SET("W",37444,.XMOPT,.XMOX) ; Write
|
|---|
| 95 | D SET("X",$S($G(XMINSTR("TYPE"))["K":37427,$G(XMINSTR("TYPE"))["X":37428,1:37426),.XMOPT,.XMOX) ; Xtract KIDS / Xtract PackMan / Xtract
|
|---|
| 96 | I XMDUZ=DUZ!($G(XMV("PRIV"))["W") D
|
|---|
| 97 | . D OPTW(XMDUZ,XMZ,XMIM("FROM"),XMIU("ORIGN8"),XMSECPAK,.XMINSTR)
|
|---|
| 98 | E D
|
|---|
| 99 | . D OPTWNO^XMXSEC3(XMIU("ORIGN8"))
|
|---|
| 100 | D OPTR(XMDUZ,XMK,XMZ,.XMIU,XMSECPAK,.XMINSTR)
|
|---|
| 101 | I DUZ=.6 D Q("R",37422.6) ; SHARED,MAIL may not Reply to a message.
|
|---|
| 102 | I XMDUZ=.6 D DOSHARE^XMXSEC3(XMDUZ,XMK,XMIU("ORIGN8"),.XMINSTR) Q
|
|---|
| 103 | I XMDUZ=.5,XMK>999 D DOPOST^XMXSEC3
|
|---|
| 104 | Q
|
|---|
| 105 | OPTW(XMDUZ,XMZ,XMFROM,XMORIGN8,XMSECPAK,XMINSTR) ; User must be self or have 'write' privilege as surrogate.
|
|---|
| 106 | I XMINSTR("TYPE")["X"!(XMINSTR("TYPE")["K") D Q("A",37401.4) ; You may not Answer a KIDS or PackMan message.
|
|---|
| 107 | I XMINSTR("FLAGS")["X",'XMORIGN8 D Q("C",37403.1) ; Only the originator may Copy a 'closed' message.
|
|---|
| 108 | I $D(^XMB(3.9,XMZ,"K")) D
|
|---|
| 109 | . I XMSECPAK D Q("C",37403.4) ; You may not Copy a secure KIDS or PackMan message.
|
|---|
| 110 | . E D
|
|---|
| 111 | . . I '$D(XMOPT("A","?")) D Q("A",37401.2) ; You may not Answer a scrambled message. Use Reply.
|
|---|
| 112 | . . I '$D(XMOPT("C","?")) D Q("C",37403.2) ; You may not Copy a scrambled message.
|
|---|
| 113 | I '$D(XMOPT("A","?")),'$$GOTNS^XMVVITA(XMDUZ) D
|
|---|
| 114 | . ; pgmr note: this must be the last place that sets XMOPT("A","?").
|
|---|
| 115 | . I XMDUZ=DUZ D Q("A",37401.1) Q ; You must have a Network Signature to Answer a message.
|
|---|
| 116 | . S XMOPT("A","?")=$$EZBLD^DIALOG(37401.3,XMV("NAME")) ; |1| must have a Network Signature to Answer a message.
|
|---|
| 117 | I 'XMORIGN8 D Q
|
|---|
| 118 | . D Q("IN",37409.1) ; Only the originator may toggle 'Information only'.
|
|---|
| 119 | . D Q("E",37405.1) ; Only the originator may Edit a message.
|
|---|
| 120 | I $P($G(^XMB(3.9,XMZ,1,0)),U,4)>1!(XMFROM'=$O(^XMB(3.9,XMZ,1,"C",0))) D Q
|
|---|
| 121 | . ; You may not Edit a message you have already sent to someone else.
|
|---|
| 122 | . ; You may toggle the 'information only' switch, if you wish.
|
|---|
| 123 | . I $G(XMQDNUM) S XMOPT("E","?")=37405.2 Q
|
|---|
| 124 | . N DIR
|
|---|
| 125 | . D BLD^DIALOG(37405.2,"","","DIR(""?"")")
|
|---|
| 126 | . M XMOPT("E","?")=DIR("?")
|
|---|
| 127 | I $O(^XMB(3.9,XMZ,3,0)) D Q("E",37405.3) Q ; You may not Edit a message which has a reply.
|
|---|
| 128 | I XMSECPAK D Q("E",37405.4) ; You may not Edit a secure KIDS or PackMan message.
|
|---|
| 129 | Q
|
|---|
| 130 | OPTR(XMDUZ,XMK,XMZ,XMIU,XMSECPAK,XMINSTR) ; User must be self or have 'read' privilege as surrogate.
|
|---|
| 131 | I '$O(^XMB(3.9,XMZ,2005,0)) D Q("AA",37402.1) ; This message has no Attachments.
|
|---|
| 132 | I 'XMK D
|
|---|
| 133 | . D Q("D",37404.1) ; This message has already been deleted. It's not in a basket.
|
|---|
| 134 | . D Q("V",37425.1) ; This message has already vaporized. It's not in a basket.
|
|---|
| 135 | I XMINSTR("FLAGS")'["P" D Q("K",37412.1) ; The message must be 'priority' in order to toggle 'Priority replies'.
|
|---|
| 136 | I XMINSTR("FLAGS")["X",'XMIU("ORIGN8") D Q("F",37406.1) ; Only the originator may forward a 'closed' message.
|
|---|
| 137 | I XMSECPAK D
|
|---|
| 138 | . D Q("P",37416.4) ; You may not Print a secure KIDS or PackMan message.
|
|---|
| 139 | . S XMOPT("H","?")=XMOPT("P","?")
|
|---|
| 140 | . D Q("R",37422.4) ; You may not Reply to a secure KIDS or PackMan message.
|
|---|
| 141 | E I 'XMIU("ORIGN8") D
|
|---|
| 142 | . I XMINSTR("FLAGS")["I" D Q("R",37422.1) Q ; Only the originator may Reply to an 'Information only' message.
|
|---|
| 143 | . I $P($G(^XMB(3.9,XMZ,1,XMIU("IEN"),"T")),U,1)="I" D Q("R",37422.2) ; 'Information only' recipients may not reply to a message.
|
|---|
| 144 | E I $$BCAST^XMXSEC(XMZ) D Q("R",37422.3) ; May not reply to a Broadcast message. Send a new one.
|
|---|
| 145 | I XMINSTR("TYPE")["X"!(XMINSTR("TYPE")["K") D
|
|---|
| 146 | . I '$D(^XUSEC("XUPROGMODE",DUZ)) D Q("X",37428.2) ; You must hold the XUPROGMODE key to extract KIDS or PackMan messages.
|
|---|
| 147 | E D Q("X",37428.1) ; This message is neither KIDS nor PackMan.
|
|---|
| 148 | Q
|
|---|
