Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XMXSEC1

XMXSEC1.m

Go to the documentation of this file.
  1. XMXSEC1 ;ISC-SF/GMB - Message security and restrictions (cont.) ;05/17/2002 13:26
  1. ;;8.0;MailMan;**47**;Jun 28, 2002;Build 6
  1. ; All entry points covered by DBIA 2732.
  1. GETRESTR(XMDUZ,XMZ,XMZREC,XMINSTR,XMRESTR) ;
  1. ; If a message is closed, it may not be forwarded to SHARED,MAIL, even by the sender
  1. I $G(XMZREC)="" S XMZREC=$G(^XMB(3.9,XMZ,0))
  1. I "^Y^y^"[(U_$P(XMZREC,U,9)_U) D
  1. . S:$G(XMRESTR("FLAGS"))'["X" XMRESTR("FLAGS")=$G(XMRESTR("FLAGS"))_"X"
  1. E I $G(XMRESTR("FLAGS"))["X" S XMRESTR("FLAGS")=$TR(XMRESTR("FLAGS"),"X")
  1. ; If a message is confidential, it may not be forwarded to SHARED,MAIL
  1. I "^Y^y^"[(U_$P(XMZREC,U,11)_U) D
  1. . S:$G(XMRESTR("FLAGS"))'["C" XMRESTR("FLAGS")=$G(XMRESTR("FLAGS"))_"C"
  1. E I $G(XMRESTR("FLAGS"))["C" S XMRESTR("FLAGS")=$TR(XMRESTR("FLAGS"),"C")
  1. Q:$G(XMINSTR("ADDR FLAGS"))["R"
  1. ; If a message is priority, it may not be forwarded to groups unless
  1. ; the site has chosen to allow it, or if
  1. ; the user is the originator or possesses the proper security key,
  1. I $P(XMZREC,U,7)["P",'$P($G(^XMB(1,1,2)),U,1),'$$ORIGIN8R^XMXSEC(XMDUZ,XMZREC),'$D(^XUSEC("XM GROUP PRIORITY",XMDUZ)) S XMRESTR("NOFPG")=""
  1. E K:$D(XMRESTR("NOFPG")) XMRESTR("NOFPG")
  1. ; If a message has responses, it may not be broadcast. Users w/auto-
  1. ; forward addresses would not see the responses.
  1. I $O(^XMB(3.9,XMZ,3,0)) S XMRESTR("NOBCAST")=""
  1. ; If a message is more lines than the limit,
  1. ; then it may not be sent/forwarded to a remote site.
  1. D CHKLINES(XMDUZ,XMZ,.XMRESTR)
  1. Q
  1. CHKLINES(XMDUZ,XMZ,XMRESTR) ; Replaces NO^XMA21A
  1. N XMLIMIT
  1. Q:$D(^XUSEC("XMMGR",XMDUZ))
  1. S XMLIMIT=$P($G(^XMB(1,1,"NETWORK-LIMIT")),U)
  1. I XMLIMIT,$P($G(^XMB(3.9,XMZ,2,0)),U,4)>XMLIMIT S XMRESTR("NONET")=XMLIMIT Q
  1. K:$D(XMRESTR("NONET")) XMRESTR("NONET")
  1. Q
  1. CHKMSG(XMDUZ,XMK,XMKZ,XMZ,XMZREC) ; Is the message where the calling routine says it is,
  1. ; and is the user authorized to access it?
  1. I $G(XMK) D Q
  1. . S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,""))
  1. . I 'XMZ D Q
  1. . . N XMPARM
  1. . . S XMPARM(1)=XMKZ,XMPARM(2)=XMK
  1. . . D ERRSET^XMXUTIL(34351,.XMPARM) ; Message _XMKZ_ in basket _XMK_ does not exist.
  1. . S XMZREC=$G(^XMB(3.9,XMZ,0))
  1. . I XMZREC'="" D:XMDUZ'=DUZ Q
  1. . . N X
  1. . . S X=$$SURRACC^XMXSEC(XMDUZ,"",XMZ,XMZREC)
  1. . N XMPARM
  1. . S XMPARM(1)=XMZ,XMPARM(2)=XMKZ,XMPARM(3)=XMK
  1. . D ERRSET^XMXUTIL(34352,.XMPARM) ; Message _XMZ_ (message _XMKZ_ in basket _XMK_) does not exist.
  1. S XMZ=XMKZ
  1. S XMZREC=$G(^XMB(3.9,XMZ,0))
  1. I XMZREC="" D ERRSET^XMXUTIL(34354,XMZ) Q ; Message _XMZ_ does not exist.
  1. Q:'$$ACCESS^XMXSEC(XMDUZ,XMZ,XMZREC)
  1. S XMK=+$O(^XMB(3.7,"M",XMZ,XMDUZ,""))
  1. Q:'XMK
  1. S XMKZ=$P($G(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)),U,2)
  1. I 'XMKZ D ADDITM^XMUT4A(XMDUZ,XMK,XMZ,.XMKZ)
  1. Q
  1. PAKMAN(XMZ,XMZREC) ; Returns 1 if this is a packman msg; 0 if not.
  1. ; Unfortunately, there isn't always an "X" in piece 7 of the zero node,
  1. ; so we must go check out the first line of text.
  1. N XMTYPE
  1. I $G(XMZREC)="" S XMZREC=$G(^XMB(3.9,XMZ,0))
  1. S XMTYPE=$P(XMZREC,U,7)
  1. I "P"[XMTYPE D Q XMTYPE ; "P" means priority, and it exists along with
  1. . ; message type in piece 7 in all MailMan versions thru 7.*
  1. . N XMREC,XMI
  1. . S XMTYPE=0
  1. . S XMI=$O(^XMB(3.9,XMZ,2,.999999)) I 'XMI Q
  1. . S XMREC=^XMB(3.9,XMZ,2,XMI,0)
  1. . Q:$E(XMREC,1)'="$"
  1. . I XMREC?1"$TXT Created by".E1" at ".E1" on ".E S XMTYPE=1 Q ; Unsecured PackMan
  1. . I XMREC?1"$TXT PACKMAN BACKUP".E S XMTYPE=1 Q ; PackMan Backup
  1. . I XMREC?1"$TXT ^Created by".E1" at ".E1" on ".E S XMTYPE=1 Q ; Secured PackMan
  1. Q:XMTYPE="K"!(XMTYPE="X") 1 ; PackMan message (KIDS or regular)
  1. Q 0
  1. OPTGRP(XMDUZ,XMK,XMOPT,XMOX,XMQDNUM) ; What may the user do at the basket/message group level?
  1. I XMK D
  1. . I XMDUZ=.5,XMK>999 D OPTPOST(.XMOPT,.XMOX) Q
  1. . D OPTUSER1(XMDUZ,.XMOPT,.XMOX)
  1. . D OPTUSER2(XMK,.XMOPT,.XMOX)
  1. E D
  1. . I XMK="!" D OPTSS(XMDUZ,.XMOPT,.XMOX) Q
  1. . D OPTUSER1(XMDUZ,.XMOPT,.XMOX)
  1. Q
  1. SET(XMCD,XMDN,XMOPT,XMOX) ;
  1. N XMDREC
  1. S XMDREC=$$EZBLD^DIALOG(XMDN)
  1. S XMOPT(XMCD)=$P(XMDREC,":",2,99)
  1. S XMOX("O",XMCD)=$P(XMDREC,":",1) ; "O"=original english to foreign
  1. S XMOX("X",$P(XMDREC,":",1))=XMCD ; "X"=translate foreign to english
  1. Q
  1. Q(XMCD,XMDN) ;
  1. I $G(XMQDNUM) S XMOPT(XMCD,"?")=XMDN Q
  1. S XMOPT(XMCD,"?")=$$EZBLD^DIALOG(XMDN)
  1. Q
  1. OPTUSER1(XMDUZ,XMOPT,XMOX) ;
  1. D SET("D",37202,.XMOPT,.XMOX) ; Delete messages
  1. D SET("F",37203,.XMOPT,.XMOX) ; Forward messages
  1. D SET("FI",37204,.XMOPT,.XMOX) ; Filter messages
  1. D SET("H",37205,.XMOPT,.XMOX) ; Headerless Print messages
  1. D SET("L",37206,.XMOPT,.XMOX) ; Later messages
  1. D SET("NT",37208,.XMOPT,.XMOX) ; New Toggle messages
  1. D SET("P",37209,.XMOPT,.XMOX) ; Print messages
  1. D SET("S",37213,.XMOPT,.XMOX) ; Save messages to another basket
  1. D SET("T",37214,.XMOPT,.XMOX) ; Terminate messages
  1. I '$D(^XMB(3.7,XMDUZ,15,"AF")) D
  1. . I XMDUZ=DUZ D Q("FI",37204.1) Q ; You have no message filters defined.
  1. . S XMOPT("FI","?")=$$EZBLD^DIALOG(37204.2,XMV("NAME")) ; |1| has no message filters defined.
  1. D SET("V",37216,.XMOPT,.XMOX) ; Vaporize date set messages
  1. Q:XMDUZ'=.6
  1. D Q("L",37462) ; You may not do this in SHARED,MAIL.
  1. S XMOPT("NT","?")=XMOPT("L","?")
  1. Q:$$ZPOSTPRV^XMXSEC()
  1. ; You must hold the XMMGR key or be a POSTMASTER surrogate to do this in SHARED,MAIL.
  1. I $G(XMQDNUM) D Q
  1. . F I="D","F","FI","S","T","V" S XMOPT(I,"?")=37261
  1. N DIR
  1. D BLD^DIALOG(37261,"","","DIR(""?"")")
  1. F I="D","F","FI","S","T","V" M XMOPT(I,"?")=DIR("?")
  1. Q
  1. OPTUSER2(XMK,XMOPT,XMOX) ;
  1. D SET("C",37201,.XMOPT,.XMOX) ; Change the name of this basket
  1. D SET("N",37207,.XMOPT,.XMOX) ; New message list
  1. D SET("Q",37211,.XMOPT,.XMOX) ; Query (search for) messages in this basket
  1. D SET("R",37212,.XMOPT,.XMOX) ; Resequence messages
  1. I XMK'>1 D Q("C",37201.1) ; The name of this basket may not be changed.
  1. ;"The name of "_$S(XMK=1:"the IN",XMK=.5:"the WASTE",1:"this")_" basket may not be changed."
  1. Q:XMDUZ'=.6!$$ZPOSTPRV^XMXSEC()
  1. ; You must hold the XMMGR key or be a POSTMASTER surrogate to do this in SHARED,MAIL.
  1. I $G(XMQDNUM) S XMOPT("C","?")=37261 Q
  1. N DIR
  1. D BLD^DIALOG(37261,"","","DIR(""?"")")
  1. M XMOPT("C","?")=DIR("?")
  1. Q
  1. OPTPOST(XMOPT,XMOX) ;
  1. D SET("D",37202,.XMOPT,.XMOX) ; Delete messages
  1. D SET("F",37203,.XMOPT,.XMOX) ; Forward messages (Added so that postmaster could reroute messages which for some reason were addressed to the wrong domain.)
  1. D SET("Q",37211,.XMOPT,.XMOX) ; Query (search for) messages in this basket
  1. D SET("R",37212,.XMOPT,.XMOX) ; Resequence messages
  1. D SET("X",37219,.XMOPT,.XMOX) ; Xmit Priority toggle
  1. Q
  1. OPTSS(XMDUZ,XMOPT,XMOX) ; Super Search
  1. D SET("H",37205,.XMOPT,.XMOX) ; Headerless Print messages
  1. D SET("P",37209,.XMOPT,.XMOX) ; Print messages
  1. Q
  1. COPYAMT(XMZ,XMWHICH) ; Checks total number of lines to be copied and total number of responses to be copied.
  1. ; Function returns 1 if OK; 0 if not OK.
  1. ; XMWHICH string of which responses to copy (0=original msg).
  1. ; Default = original msg and all responses.
  1. N XMLIMIT,XMRESPS,XMABORT
  1. S XMABORT=0
  1. S XMLIMIT=$$COPYLIMS
  1. S XMRESPS=+$P($G(^XMB(3.9,XMZ,3,0)),U,4)
  1. I XMRESPS=0 D TOOMANY(+$P($G(^XMB(3.9,XMZ,2,0)),U,4),$P(XMLIMIT,U,3),37470,.XMABORT) Q 'XMABORT
  1. N I,J,XMRANGE,XMLINES
  1. S:'$D(XMWHICH) XMWHICH="0-"_XMRESPS
  1. S (XMRESPS,XMLINES)=0
  1. ; **Patch XM*8*47 modifies the FOR loop to work when XMWHICH does not contain a ",". Added a conditional so that response(XMRESPS) lines are counted correctly.**
  1. F I=1:1:$L(XMWHICH,",") D
  1. . S XMRANGE=$P(XMWHICH,",",I)
  1. . F J=$P(XMRANGE,"-",1):1:$S(XMRANGE["-":$P(XMRANGE,"-",2),1:XMRANGE) D
  1. . . I J=0 S XMLINES=XMLINES+$P($G(^XMB(3.9,XMZ,2,0)),U,4)
  1. . . I J'=0 S XMRESPS=XMRESPS+1,XMLINES=XMLINES+$P($G(^XMB(3.9,+$G(^XMB(3.9,XMZ,3,J,0)),2,0)),U,4)
  1. D TOOMANY(XMLINES,$P(XMLIMIT,U,3),37470,.XMABORT) Q:XMABORT 0
  1. D TOOMANY(XMRESPS,$P(XMLIMIT,U,2),37471,.XMABORT) Q:XMABORT 0
  1. Q 1
  1. TOOMANY(HOWMANY,XMLIMIT,XMDIALOG,XMABORT) ;
  1. Q:HOWMANY'>XMLIMIT
  1. S XMABORT=1
  1. D ERRSET^XMXUTIL(XMDIALOG,XMLIMIT) ; You may not copy more than the site limit of _XMLIMIT_ lines / responses.
  1. Q
  1. COPYLIMS() ; Function returns copy limits string.
  1. ; limits: # recipients^# responses^# lines
  1. N I
  1. S XMLIMIT=$G(^XMB(1,1,.11))
  1. F I=1:1:3 I '$P(XMLIMIT,U,I) S $P(XMLIMIT,U,I)=$P("2999^99^3999",U,I)
  1. Q XMLIMIT
  1. COPYRECP(XMZ) ; Checks total number of recipients to see if it's OK to list them in the copy text and send the copy to them, too.
  1. ; Function returns 1 if OK; 0 if not OK.
  1. N XMLIMIT
  1. S XMLIMIT=$$COPYLIMS
  1. Q:$P($G(^XMB(3.9,XMZ,1,0)),U,4)'>$P(XMLIMIT,U,1) 1
  1. D ERRSET^XMXUTIL(37472,$P(XMLIMIT,U,1))
  1. ;Because this message has more than the site limit of _X_ recipients,
  1. ;we will neither list them in the text of the copy,
  1. ;nor will we deliver the copy to them.
  1. Q 0
  1. SSPRIV() ; Is the user authorized to conduct a super search?
  1. Q:$$ZSSPRIV 1
  1. D ERRSET^XMXUTIL(34413.5)
  1. Q 0
  1. ZSSPRIV() ; Is the user authorized to conduct a super search?
  1. I DUZ'<1,$D(^XUSEC("XM SUPER SEARCH",DUZ)) Q 1
  1. Q 0
  1. ACCESS2(XMDUZ,XMZ,XMZREC) ; The user (XMDUZ) is not a recipient
  1. N XMOK ; of the message, but did he send it?
  1. I XMDUZ=$P(XMZREC,U,2)!(XMDUZ=$P(XMZREC,U,4)) D Q XMOK
  1. . I XMDUZ='DUZ,'$$SURRACC^XMXSEC(XMDUZ,"",XMZ,XMZREC) S XMOK=0 Q
  1. . ; The user sent the message, so add him to it.
  1. . D ADDRECP^XMTDL(XMZ,$P(XMZREC,U,7)["P",XMDUZ)
  1. . S XMOK=1
  1. I XMDUZ'=DUZ D Q 0
  1. . Q:'$$ACCESS^XMXSEC(DUZ,XMZ,XMZREC)
  1. . D ERRSET^XMXUTIL(37103,XMV("NAME"),XMZ)
  1. . ; You may not access this message as |1| unless you
  1. . ; or someone else on the message forwards it to |1|.
  1. D ERRSET^XMXUTIL(37102,"",XMZ)
  1. ; You are neither a sender nor a recipient of this message.
  1. ; If you need to see it, ask someone to forward it to you.
  1. Q 0