| 1 | XMXSEC ;ISC-SF/GMB-Message security and restrictions ;05/17/2002 13:25
|
|---|
| 2 | ;;8.0;MailMan;;Jun 28, 2002
|
|---|
| 3 | ; All entry points covered by DBIA 2731.
|
|---|
| 4 | BCAST(XMZ) ; 0=msg was not broadcast; 1=msg was broadcast
|
|---|
| 5 | N XMBCAST
|
|---|
| 6 | S XMBCAST=$$EZBLD^DIALOG(39006) ; * (Broadcast to all local users)
|
|---|
| 7 | Q:$D(^XMB(3.9,XMZ,1,"C",$E(XMBCAST,1,30))) 1
|
|---|
| 8 | Q:$D(^XMB(3.9,XMZ,1,"C",XMBCAST)) 1
|
|---|
| 9 | Q 0
|
|---|
| 10 | ZCLOSED(XMZ) ;
|
|---|
| 11 | Q $$CLOSED($G(^XMB(3.9,XMZ,0)))
|
|---|
| 12 | CLOSED(XMZREC) ; 0=msg is not closed; 1=msg is closed
|
|---|
| 13 | Q "^Y^y^"[(U_$P(XMZREC,U,9)_U)
|
|---|
| 14 | ZCONFID(XMZ) ;
|
|---|
| 15 | Q $$CONFID($G(^XMB(3.9,XMZ,0)))
|
|---|
| 16 | CONFID(XMZREC) ; 0=msg is not confidential; 1=msg is confidential
|
|---|
| 17 | Q "^Y^y^"[(U_$P(XMZREC,U,11)_U)
|
|---|
| 18 | ZCONFIRM(XMZ) ;
|
|---|
| 19 | Q $$CONFIRM($G(^XMB(3.9,XMZ,0)))
|
|---|
| 20 | CONFIRM(XMZREC) ; 0=msg is not confirm receipt requested; 1=msg is confirm
|
|---|
| 21 | Q "^Y^y^"[(U_$P(XMZREC,U,5)_U)
|
|---|
| 22 | ZINFO(XMZ) ;
|
|---|
| 23 | Q $$INFO($G(^XMB(3.9,XMZ,0)))
|
|---|
| 24 | INFO(XMZREC) ; 0=msg is not information only; 1=msg is information only
|
|---|
| 25 | Q "^Y^y^"[(U_$P(XMZREC,U,12)_U)
|
|---|
| 26 | ZORIGIN8(XMDUZ,XMZ) ;
|
|---|
| 27 | Q $$ORIGIN8R(XMDUZ,$G(^XMB(3.9,XMZ,0)))
|
|---|
| 28 | ORIGIN8R(XMDUZ,XMZREC) ; Did the user send the message?
|
|---|
| 29 | ; 1=user is the originator ; 0=user is NOT the originator
|
|---|
| 30 | Q:XMDUZ=$P(XMZREC,U,2) 1
|
|---|
| 31 | Q:XMDUZ=$P(XMZREC,U,4) 1
|
|---|
| 32 | Q:XMDUZ=DUZ 0
|
|---|
| 33 | Q:DUZ=$P(XMZREC,U,2) 1
|
|---|
| 34 | Q:DUZ=$P(XMZREC,U,4) 1
|
|---|
| 35 | Q 0
|
|---|
| 36 | ZPRI(XMZ) ;
|
|---|
| 37 | Q $$PRIORITY($G(^XMB(3.9,XMZ,0)))
|
|---|
| 38 | PRIORITY(XMZREC) ; 0=msg is not priority; 1=msg is priority
|
|---|
| 39 | Q $P(XMZREC,U,7)["P"
|
|---|
| 40 | SURRCONF(XMDUZ,XMZ) ; 0=msg is not confidential; 1=msg is confidential, and surrogate may not read it.
|
|---|
| 41 | ; We already know that XMDUZ'=DUZ.
|
|---|
| 42 | ; But the surrogate may read a confidential message if it was the
|
|---|
| 43 | ; surrogate who sent it.
|
|---|
| 44 | Q:"^Y^y^"'[(U_$P($G(^XMB(3.9,+XMZ,0)),U,11)_U) 0
|
|---|
| 45 | Q:DUZ=$P(^(0),U,2) 0 ; naked ref from above
|
|---|
| 46 | Q:DUZ=$P(^(0),U,4) 0 ; naked ref from above
|
|---|
| 47 | Q 1
|
|---|
| 48 | ACCESS(XMDUZ,XMZ,XMZREC) ; Determines user access to a message.
|
|---|
| 49 | ; 1=user may access; 0=user may not access
|
|---|
| 50 | Q:$D(^XMB(3.7,"M",XMZ,XMDUZ)) $S(XMDUZ=DUZ:1,1:$$SURRACC(XMDUZ,"",XMZ,$G(XMZREC))) ; Message is in user's mailbox
|
|---|
| 51 | N XMPRE
|
|---|
| 52 | S XMPRE=$P(^XMB(3.7,XMDUZ,0),U,7)
|
|---|
| 53 | I XMPRE,$P($G(^XMB(3.9,XMZ,.6)),U,1)<XMPRE D Q 0
|
|---|
| 54 | . D ERRSET^XMXUTIL(37100,$$MMDT^XMXUTIL1(XMPRE),XMZ) ; You may not access any message prior to _X_ unless someone forwards it to you.
|
|---|
| 55 | Q:$D(^XMB(3.9,XMZ,1,"C",XMDUZ)) $S(XMDUZ=DUZ:1,1:$$SURRACC(XMDUZ,"",XMZ,$G(XMZREC))) ; User is recipient
|
|---|
| 56 | ;Q:$D(^XMB(3.9,XMZ,1,"C",DUZ)) 1 ; Surrogate is a recipient.
|
|---|
| 57 | ; We comment out the above line, because it's not enough that the
|
|---|
| 58 | ; surrogate is a recipient of the message. If the surrogate wants to
|
|---|
| 59 | ; access the message as XMDUZ, and the message is not in the mailbox
|
|---|
| 60 | ; of XMDUZ, then the message must have been sent by or to XMDUZ.
|
|---|
| 61 | Q:$$BCAST(XMZ) 1
|
|---|
| 62 | I $G(XMZREC)="" S XMZREC=$G(^XMB(3.9,XMZ,0))
|
|---|
| 63 | I $P(XMZREC,U,8) D Q 0
|
|---|
| 64 | . N XMPARM
|
|---|
| 65 | . S XMPARM(1)=XMZ,XMPARM(2)=$P(XMZREC,U,8)
|
|---|
| 66 | . D ERRSET^XMXUTIL(37101,.XMPARM,XMZ) ; Message _XMZ_ is a response to message _$P(XMZREC,U,8)_.
|
|---|
| 67 | ; User (XMDUZ) is not a recipient. Investigate further.
|
|---|
| 68 | Q $$ACCESS2^XMXSEC1(XMDUZ,XMZ,XMZREC)
|
|---|
| 69 | SURRACC(XMDUZ,XMACCESS,XMZ,XMZREC) ; Determines surrogate access to a message.
|
|---|
| 70 | ; Assumes that we already know that XMDUZ is authorized to see this
|
|---|
| 71 | ; message, and that XMDUZ'=DUZ. Now we want to know if DUZ may see it.
|
|---|
| 72 | ; 1=surrogate may access; 0=surrogate may not access
|
|---|
| 73 | I $G(XMZREC)="" S XMZREC=$G(^XMB(3.9,XMZ,0))
|
|---|
| 74 | Q:'$$CONFID(XMZREC) 1 ; Message isn't confidential.
|
|---|
| 75 | Q:DUZ=$P(XMZREC,U,2) 1 ; Surrogate sent the message.
|
|---|
| 76 | Q:DUZ=$P(XMZREC,U,4) 1 ; Surrogate sent the message.
|
|---|
| 77 | ;Q:$D(^XMB(3.9,XMZ,1,"C",DUZ)) 1 ; Surrogate is a recipient.
|
|---|
| 78 | I $G(XMACCESS)'="" D ERRSET^XMXUTIL(37452,XMACCESS,XMZ) Q 0 ; Surrogates may not _XMACCESS_ CONFIDENTIAL messages.
|
|---|
| 79 | D ERRSET^XMXUTIL(37451,XMZ) ; Surrogates may not access or do anything to Confidential messages.
|
|---|
| 80 | Q 0
|
|---|
| 81 | ANSWER(XMDUZ,XMZ,XMZREC) ; Answer (1=may, 0=may not)
|
|---|
| 82 | I DUZ=.6!(XMDUZ=.6) D ERRSET^XMXUTIL(37462,"",XMZ) Q 0 ; You may not do this in SHARED,MAIL.
|
|---|
| 83 | I XMDUZ'=DUZ Q:'$$WPRIV 0 Q:'$$SURRACC(XMDUZ,"",XMZ,.XMZREC) 0 ; "answer"
|
|---|
| 84 | I $G(XMZREC)="" S XMZREC=$G(^XMB(3.9,XMZ,0))
|
|---|
| 85 | I $$PAKMAN^XMXSEC1(XMZ,XMZREC) D ERRSET^XMXUTIL(37401.4,"",XMZ) Q 0 ; May not answer a PackMan message.
|
|---|
| 86 | I $D(^XMB(3.9,XMZ,"K")) D ERRSET^XMXUTIL(47401.2,"",XMZ) Q 0 ; May not answer a scrambled message. Use Reply.
|
|---|
| 87 | I '$$GOTNS^XMVVITA(XMDUZ) D ERRSET^XMXUTIL($S(XMDUZ=DUZ:37401.1,1:37401.3),XMV("NAME"),XMZ) Q 0 ; You / X must have a network signature in order to answer a message.
|
|---|
| 88 | Q 1
|
|---|
| 89 | COPY(XMDUZ,XMZ,XMZREC) ; Copy (1=may, 0=may not)
|
|---|
| 90 | I XMDUZ'=DUZ Q:'$$WPRIV 0 Q:'$$SURRACC(XMDUZ,"",XMZ,.XMZREC) 0 ; "copy"
|
|---|
| 91 | I $G(XMZREC)="" S XMZREC=$G(^XMB(3.9,XMZ,0))
|
|---|
| 92 | I $$CLOSED(XMZREC),'$$ORIGIN8R(XMDUZ,XMZREC) D ERRSET^XMXUTIL(37403.1,"",XMZ) Q 0 ; Only the message originator may copy CLOSED messages.
|
|---|
| 93 | I XMDUZ=.6,DUZ'=$P(XMZREC,U,2),DUZ'=$P(XMZREC,U,4) D ERRSET^XMXUTIL(37403.6,"",XMZ) Q 0 ; Only the originator may copy messages in SHARED,MAIL.
|
|---|
| 94 | I $D(^XMB(3.9,XMZ,"K")) D ERRSET^XMXUTIL(37403.2,"",XMZ) Q 0 ; May not copy a scrambled message.
|
|---|
| 95 | Q 1
|
|---|
| 96 | INCLUDE(XMDUZ,XMZ,XMZREC) ; Include message XMZ as part of another message (1=may, 0=may not)
|
|---|
| 97 | ; If XMDUZ'=DUZ, assumes that surrogate has the privilege to
|
|---|
| 98 | ; send a new message, or reply to a message.
|
|---|
| 99 | Q:'$$ACCESS(XMDUZ,XMZ,.XMZREC) 0
|
|---|
| 100 | I $G(XMZREC)="" S XMZREC=$G(^XMB(3.9,XMZ,0))
|
|---|
| 101 | I $$CLOSED(XMZREC),'$$ORIGIN8R(XMDUZ,XMZREC) D ERRSET^XMXUTIL(37403.1,"",XMZ) Q 0 ; Only the message originator may copy CLOSED messages.
|
|---|
| 102 | I $D(^XMB(3.9,XMZ,"K")) D ERRSET^XMXUTIL(37403.2,"",XMZ) Q 0 ; May not copy a scrambled message.
|
|---|
| 103 | Q 1
|
|---|
| 104 | DELETE(XMDUZ,XMK,XMZ,XMZREC) ; Delete, Terminate (1=may, 0=may not)
|
|---|
| 105 | Q:XMDUZ=DUZ 1
|
|---|
| 106 | Q:'$$RWPRIV 0
|
|---|
| 107 | ;I XMDUZ=.5,$G(XMK,$O(^XMB(3.7,"M",XMZ,XMDUZ,"")))>999 Q 1
|
|---|
| 108 | I XMDUZ=.5 Q 1
|
|---|
| 109 | Q:'$$SURRACC(XMDUZ,"",XMZ,.XMZREC) 0 ; "delete"
|
|---|
| 110 | I $G(XMZREC)="" S XMZREC=$G(^XMB(3.9,XMZ,0))
|
|---|
| 111 | I XMDUZ=.6,DUZ'=$P(XMZREC,U,2),DUZ'=$P(XMZREC,U,4),'$D(^XUSEC("XMMGR",DUZ)),'$D(^XMB(3.7,"AB",DUZ,.5,0)) D Q 0
|
|---|
| 112 | . D ERRSET^XMXUTIL(37461,"",XMZ) ; Only the originator, postmaster surrogate, or XMMGR key holder may do this in SHARED,MAIL.
|
|---|
| 113 | Q 1
|
|---|
| 114 | FORWARD(XMDUZ,XMZ,XMZREC) ; Forward (1=may, 0=may not)
|
|---|
| 115 | I XMDUZ'=DUZ Q:'$$RWPRIV 0 Q:'$$SURRACC(XMDUZ,"",XMZ,.XMZREC) 0 ; "forward"
|
|---|
| 116 | I $G(XMZREC)="" S XMZREC=$G(^XMB(3.9,XMZ,0))
|
|---|
| 117 | I $$CLOSED(XMZREC),'$$ORIGIN8R(XMDUZ,XMZREC) D ERRSET^XMXUTIL(37406.1,"",XMZ) Q 0 ; Only the message originator may forward CLOSED messages.
|
|---|
| 118 | I XMDUZ=.6,DUZ'=$P(XMZREC,U,2),DUZ'=$P(XMZREC,U,4) D ERRSET^XMXUTIL(37406.6,"",XMZ) Q 0 ; Only the originator may forward messages in SHARED,MAIL.
|
|---|
| 119 | Q 1
|
|---|
| 120 | LATER(XMDUZ) ; Later or New Toggle (1=may, 0=may not)
|
|---|
| 121 | I DUZ=.6!(XMDUZ=.6) D ERRSET^XMXUTIL(37462) Q 0 ; SHARED,MAIL may not 'later' or 'new toggle' a message.
|
|---|
| 122 | Q:XMDUZ=DUZ 1
|
|---|
| 123 | Q $$RWPRIV
|
|---|
| 124 | MOVE(XMDUZ,XMZ,XMZREC) ; Save or Filter (1=may, 0=may not)
|
|---|
| 125 | Q:XMDUZ=DUZ 1
|
|---|
| 126 | Q:'$$RWPRIV 0
|
|---|
| 127 | ;Q:'$$SURRACC(XMDUZ,"",XMZ,.XMZREC) 0 ; "save"
|
|---|
| 128 | I $G(XMZREC)="" S XMZREC=$G(^XMB(3.9,XMZ,0))
|
|---|
| 129 | I XMDUZ=.6,DUZ'=$P(XMZREC,U,2),DUZ'=$P(XMZREC,U,4),'$D(^XUSEC("XMMGR",DUZ)),'$D(^XMB(3.7,"AB",DUZ,.5,0)) D Q 0
|
|---|
| 130 | . D ERRSET^XMXUTIL(37461,"",XMZ) ; Only the originator, postmaster surrogate, or XMMGR key holder may do this in SHARED,MAIL.
|
|---|
| 131 | Q 1
|
|---|
| 132 | READ(XMDUZ,XMZ,XMZREC) ; Read or Print (1=may, 0=may not)
|
|---|
| 133 | Q:XMDUZ=DUZ 1
|
|---|
| 134 | Q $$SURRACC(XMDUZ,"",XMZ,.XMZREC) ; "access"
|
|---|
| 135 | REPLY(XMDUZ,XMZ,XMZREC) ; Reply (1=may, 0=may not)
|
|---|
| 136 | ; Should we make sure XMZ is an original msg and not a reply?
|
|---|
| 137 | ; Should we make sure the msg has recipients?
|
|---|
| 138 | I DUZ=.6 D ERRSET^XMXUTIL(37422.6,"",XMZ) Q 0 ; May not reply to message as SHARED,MAIL.
|
|---|
| 139 | I XMDUZ'=DUZ Q:'$$RWPRIV 0 Q:'$$SURRACC(XMDUZ,"",XMZ,.XMZREC) 0 ; "reply to"
|
|---|
| 140 | I $G(XMZREC)="" S XMZREC=$G(^XMB(3.9,XMZ,0))
|
|---|
| 141 | I $D(^XMB(3.9,XMZ,"K")),$$PAKMAN^XMXSEC1(XMZ,XMZREC) D ERRSET^XMXUTIL(37422.4,"",XMZ) Q 0 ; May not reply to secure PackMan message.
|
|---|
| 142 | Q:$$ORIGIN8R(XMDUZ,XMZREC) 1
|
|---|
| 143 | I $$INFO(XMZREC) D ERRSET^XMXUTIL(37422.1,"",XMZ) Q 0 ; Only originator may reply to 'INFORMATION ONLY' message.
|
|---|
| 144 | I $P($G(^XMB(3.9,XMZ,1,+$O(^XMB(3.9,XMZ,1,"C",XMDUZ,0)),"T")),U,1)["I" D ERRSET^XMXUTIL(37422.2,"",XMZ) Q 0 ; 'INFORMATION ONLY' recipient may not reply to message.
|
|---|
| 145 | I $P(XMZREC,U,2)["POSTMASTER@" D ERRSET^XMXUTIL(37422.5,"",XMZ) Q 0 ; You may not reply to a message from a remote Postmaster."
|
|---|
| 146 | Q 1
|
|---|
| 147 | SEND(XMDUZ,XMINSTR) ; Send (1=may, 0=may not)
|
|---|
| 148 | I DUZ=.6!(XMDUZ=.6) D ERRSET^XMXUTIL(37462) Q 0 ; You may not do this in SHARED,MAIL.
|
|---|
| 149 | Q:XMDUZ=DUZ 1
|
|---|
| 150 | Q:$D(XMINSTR("FROM")) 1
|
|---|
| 151 | Q:XMDUZ=.5 1
|
|---|
| 152 | Q $$WPRIV
|
|---|
| 153 | RWPRIV() ; Does the surrogate have 'read' or 'send' privilege? (1=yes, 0=no)
|
|---|
| 154 | Q:$G(XMV("PRIV"))["R"!($G(XMV("PRIV"))["W") 1
|
|---|
| 155 | D ERRSET^XMXUTIL(37457,XMV("NAME")) ; You do not have 'read' or 'send' privilege for "_XMV("NAME")
|
|---|
| 156 | Q 0
|
|---|
| 157 | RPRIV() ; Does the surrogate have 'read' privilege? (1=yes, 0=no)
|
|---|
| 158 | Q:$G(XMV("PRIV"))["R" 1
|
|---|
| 159 | D ERRSET^XMXUTIL(37455,XMV("NAME")) ; You do not have 'read' privilege for "_XMV("NAME")
|
|---|
| 160 | Q 0
|
|---|
| 161 | WPRIV() ; Does the surrogate have 'send' privilege? (1=yes, 0=no)
|
|---|
| 162 | Q:$G(XMV("PRIV"))["W" 1
|
|---|
| 163 | D ERRSET^XMXUTIL(37456,XMV("NAME")) ; You do not have 'send' privilege for "_XMV("NAME")
|
|---|
| 164 | Q 0
|
|---|
| 165 | POSTPRIV() ; Perform postmaster actions (1=may, 0=may not)
|
|---|
| 166 | ; This includes permission to perform group message actions in Shared,Mail.
|
|---|
| 167 | I '$D(^XUSEC("XMMGR",DUZ)),'$D(^XMB(3.7,"AB",DUZ,.5)) D ERRSET^XMXUTIL(37458) Q 0 ; Only a POSTMASTER surrogate or XMMGR key holder may do this.
|
|---|
| 168 | Q 1
|
|---|
| 169 | ZPOSTPRV() ; Perform postmaster actions (1=may, 0=may not)
|
|---|
| 170 | ; This includes permission to perform group message actions in Shared,Mail.
|
|---|
| 171 | Q:$D(^XUSEC("XMMGR",DUZ)) 1
|
|---|
| 172 | Q:$D(^XMB(3.7,"AB",DUZ,.5)) 1
|
|---|
| 173 | Q 0
|
|---|
