source: FOIAVistA/trunk/r/MAILMAN-XM/XMXSEC.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 9.3 KB
Line 
1XMXSEC ;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.
4BCAST(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
10ZCLOSED(XMZ) ;
11 Q $$CLOSED($G(^XMB(3.9,XMZ,0)))
12CLOSED(XMZREC) ; 0=msg is not closed; 1=msg is closed
13 Q "^Y^y^"[(U_$P(XMZREC,U,9)_U)
14ZCONFID(XMZ) ;
15 Q $$CONFID($G(^XMB(3.9,XMZ,0)))
16CONFID(XMZREC) ; 0=msg is not confidential; 1=msg is confidential
17 Q "^Y^y^"[(U_$P(XMZREC,U,11)_U)
18ZCONFIRM(XMZ) ;
19 Q $$CONFIRM($G(^XMB(3.9,XMZ,0)))
20CONFIRM(XMZREC) ; 0=msg is not confirm receipt requested; 1=msg is confirm
21 Q "^Y^y^"[(U_$P(XMZREC,U,5)_U)
22ZINFO(XMZ) ;
23 Q $$INFO($G(^XMB(3.9,XMZ,0)))
24INFO(XMZREC) ; 0=msg is not information only; 1=msg is information only
25 Q "^Y^y^"[(U_$P(XMZREC,U,12)_U)
26ZORIGIN8(XMDUZ,XMZ) ;
27 Q $$ORIGIN8R(XMDUZ,$G(^XMB(3.9,XMZ,0)))
28ORIGIN8R(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
36ZPRI(XMZ) ;
37 Q $$PRIORITY($G(^XMB(3.9,XMZ,0)))
38PRIORITY(XMZREC) ; 0=msg is not priority; 1=msg is priority
39 Q $P(XMZREC,U,7)["P"
40SURRCONF(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
48ACCESS(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)
69SURRACC(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
81ANSWER(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
89COPY(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
96INCLUDE(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
104DELETE(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
114FORWARD(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
120LATER(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
124MOVE(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
132READ(XMDUZ,XMZ,XMZREC) ; Read or Print (1=may, 0=may not)
133 Q:XMDUZ=DUZ 1
134 Q $$SURRACC(XMDUZ,"",XMZ,.XMZREC) ; "access"
135REPLY(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
147SEND(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
153RWPRIV() ; 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
157RPRIV() ; 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
161WPRIV() ; 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
165POSTPRIV() ; 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
169ZPOSTPRV() ; 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
Note: See TracBrowser for help on using the repository browser.