- XMPSEC ;ISC-SF/GMB-PackMan Security ;04/17/2002 11:13
- ;;8.0;MailMan;;Jun 28, 2002
- ; Code rewritten. Originally (ISC-WASH/GM/CAP)
- ; Includes the former ^XMASEC (ISC-WASH/GM)
- N I,XMTVAL,XMSTR
- W !,"This message has been secured!"
- S XMPASS=1
- I '$D(XMSECURE),'$$KEYOK^XMJMCODE(XMZ,$P(XMA0,U,10)) S XMPASS=0 Q
- W !,"Checking the package's integrity... (This may take some time.)",!
- S I=$O(^XMB(3.9,XMZ,2,.999))
- I $P(^(I,0),U,3,9999)'=$$ENCSTR^XMJMCODE("$SEC^3") S XMPASS=0 D FAIL Q
- S I=1,XMTVAL=0
- P0 F S I=$O(^XMB(3.9,XMZ,2,I)) Q:'I D
- . Q:'$D(^(I,0)) ; naked reference to line above
- . S XMSTR=^(0) ; naked reference to line above
- . I $E(XMSTR)="$" D CSCRAM(XMSTR) Q
- . I 'XMB0 W:$X>75 ! W "." Q
- . D VAL(XMSTR,.XMTVAL)
- W !,"<<< DONE >>>",!
- D:'XMPASS FAIL
- Q
- VAL(XMSTR,XMTVAL) ;
- N XMLVAL,I
- S XMLVAL=0
- F I=1:1:$L(XMSTR) S XMLVAL=$A(XMSTR,I)*I+XMLVAL
- S XMTVAL=XMTVAL+XMLVAL+$L(XMSTR)
- Q
- CSCRAM(XMSTR) ;
- S XMB0=$S(XMSTR'["TXT":1,1:0)
- I XMSTR["ROU",$P(XMSTR," ",2)?1"^".AN1"NTEG" D CNTEG Q
- I XMSTR'["$END"!($E(XMSTR,1,8)="$END TXT"&'XMB0) S XMTVAL=0,XMA0=$P(XMSTR," ",2) Q
- W "." I $P(XMSTR," ",2)="MESSAGE" Q
- S XMA0=$S(XMSTR["$GLB":$P(XMSTR,U,2),XMSTR["$GLO":$P(XMSTR,U,2),1:$P($P(XMSTR,U)," ",3))
- I XMSTR["ROU" W:$X>70 ! W $J($E(XMA0,1,9),10)
- E W !,$P($E(XMSTR,5,99),U)
- ;CHECK SUM EVALUTAION
- Q:$P(XMSTR,U,2,999)=$$ENCSTR^XMJMCODE("$SEC"_U_(XMTVAL+XMPAKMAN("XMRW")))
- W !!,"******** ",$J(XMA0,10)," has failed !!!!!!!!!!!",!!
- S (XMTVAL,XMPASS)=0
- Q
- FAIL ;
- N XMTEXT,XMTO,XMFROM
- S:'$D(XMPASS) XMPASS=0
- S XMTEXT(1,0)="A package with the subject: "_$P(^XMB(3.9,XMZ,0),U)
- S XMTEXT(2,0)="failed the security check during installation"_$S($D(XMPASS):".",1:", but was installed anyway.")
- S XMFROM=$P(^XMB(3.9,XMZ,0),U,2)
- I $G(XMFROM)["<" S XMTO(P($P(XMFROM,"<",2),">"))=""
- S XMTO(XMDUZ)=""
- D SENDMSG^XMXSEND(XMDUZ,"Failed Security","XMTEXT",.XMTO)
- Q
- CHECK ;FROM XMP2
- Q:XCF'=2
- I "$DDD$RTN$DIE$DIB$DIP$ROU$GLB$GLO$OPT$HEL$BUL$KEY$PKG$FUN"[$E(X,1,4),X[U D Q
- . D:'$D(XMPASS) FAIL
- . S X=$P(X,U)_$P(X,U,2)
- . S:$P(X," ",2)?.EU1"INIT"&($E(X,1,4)="$ROU") XMINIT=U_$P(X," ",2)
- I $E(X,1,12)="$END MESSAGE",'$D(XMPASS) D FAIL
- Q
- CNTEG ; Skip processing XXXINTEG program
- S XMINTEG=$P(X," ",2)
- F S I=$O(^XMB(3.9,XMZ,2,I)) Q:'I Q:"$END"[$E(^(I,0),1,4)
- Q
- PSECURE(XMZ,XMABORT) ; Secure the PackMan message
- N XMKEY,XMHINT,XMNO,XMSECURE
- S XMABORT=0
- D PQSEC(.XMNO,.XMABORT) Q:XMNO!XMABORT
- D CRE8KEY^XMJMCODE(.XMKEY,.XMHINT,.XMABORT) Q:XMABORT
- W !!,"Securing the message now. This may take a while.",!
- D LOADCODE^XMJMCODE
- D ADJUST^XMJMCODE(.XMKEY)
- D PSTORE(XMZ,XMKEY,XMHINT)
- D PSECIT(XMZ)
- Q
- PQSEC(XMOK,XMABORT) ;
- N DIR,Y,X
- S DIR(0)="Y"
- S DIR("A")="Do you wish to secure this message"
- S DIR("B")="NO"
- S DIR("?",1)="If you answer yes, this message will be secured"
- S DIR("?")="to ensure that what you send is what is actually received."
- D ^DIR
- I $D(DIRUT) S XMABORT=1
- S XMNO='Y
- Q
- PSTORE(XMZ,XMKEY,XMHINT) ;
- N XMFDA,XMIENS
- S XMIENS=XMZ_","
- S XMFDA(3.9,XMIENS,1.8)=$S($G(XMHINT)="":" ",1:XMHINT)
- S XMFDA(3.9,XMIENS,1.85)="1"_$$ENCSTR^XMJMCODE(XMKEY)
- D FILE^DIE("","XMFDA")
- Q
- PSECIT(XMZ) ;
- N XMSTR,I,XMTVAL
- S I=$O(^XMB(3.9,XMZ,2,.999))
- S XMSTR=^XMB(3.9,XMZ,2,I,0)
- S XMSTR=$P(XMSTR,"on")_"at "_$P(XMSTR," at ",3)_" on"_$P($P(XMSTR,"on",2)," at",1)
- S ^XMB(3.9,XMZ,2,I,0)=XMSTR_U_$$ENCSTR^XMJMCODE("$SEC^3")
- S I=0
- F S I=$O(^XMB(3.9,XMZ,2,I)) Q:'I D
- . Q:'$D(^(I,0)) ; naked reference to line above
- . S XMSTR=^(0) ; naked reference to line above
- . I $E(XMSTR)="$" D PSCRAM(XMZ,.I,XMSTR,.XMTVAL) Q
- . D VAL(XMSTR,.XMTVAL)
- S XMSTR(1)="$END MESSAGE"
- D MOVEBODY^XMXSEND(XMZ,"XMSTR","A")
- Q
- PSCRAM(XMZ,I,XMSTR,XMTVAL) ;
- I $E(XMSTR,1,4)="$END" S $P(^XMB(3.9,XMZ,2,I,0),U,2)=$$ENCSTR^XMJMCODE("$SEC"_U_(XMTVAL+XMPAKMAN("XMRW"))) Q
- I $E(XMSTR,1,4)="$ROU" D I $P(XMSTR," ",2)?.AN1"NTEG" D PNTEG(XMZ,.I,XMSTR) Q
- . W:$X>70 !
- . W $J($P(XMSTR," ",2),10)
- S XMTVAL=0
- S $P(^XMB(3.9,XMZ,2,I,0)," ",2)=$S($E(XMSTR,1,4)'="$KID":U,1:"")_$P(XMSTR," ",2)
- Q
- PNTEG(XMZ,I,XMSTR) ;
- S $P(^XMB(3.9,XMZ,2,I,0)," ",2)=U_$P(XMSTR," ",2)
- F S I=$O(^XMB(3.9,XMZ,2,I)) Q:'I S XMSTR=^(I,0) Q:"$END"[$E(XMSTR_" ",1,4) D
- . S:XMSTR?.UN1" ;;".N $P(^XMB(3.9,XMZ,2,I,0),";",3)=$$ENCSTR^XMJMCODE($P(XMSTR,";",3)+XMPAKMAN("XMRW"))
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMPSEC 4377 printed Jan 18, 2025@03:13:51 Page 2
- XMPSEC ;ISC-SF/GMB-PackMan Security ;04/17/2002 11:13
- +1 ;;8.0;MailMan;;Jun 28, 2002
- +2 ; Code rewritten. Originally (ISC-WASH/GM/CAP)
- +3 ; Includes the former ^XMASEC (ISC-WASH/GM)
- +4 NEW I,XMTVAL,XMSTR
- +5 WRITE !,"This message has been secured!"
- +6 SET XMPASS=1
- +7 IF '$DATA(XMSECURE)
- IF '$$KEYOK^XMJMCODE(XMZ,$PIECE(XMA0,U,10))
- SET XMPASS=0
- QUIT
- +8 WRITE !,"Checking the package's integrity... (This may take some time.)",!
- +9 SET I=$ORDER(^XMB(3.9,XMZ,2,.999))
- +10 IF $PIECE(^(I,0),U,3,9999)'=$$ENCSTR^XMJMCODE("$SEC^3")
- SET XMPASS=0
- DO FAIL
- QUIT
- +11 SET I=1
- SET XMTVAL=0
- P0 FOR
- SET I=$ORDER(^XMB(3.9,XMZ,2,I))
- if 'I
- QUIT
- Begin DoDot:1
- +1 ; naked reference to line above
- if '$DATA(^(I,0))
- QUIT
- +2 ; naked reference to line above
- SET XMSTR=^(0)
- +3 IF $EXTRACT(XMSTR)="$"
- DO CSCRAM(XMSTR)
- QUIT
- +4 IF 'XMB0
- if $X>75
- WRITE !
- WRITE "."
- QUIT
- +5 DO VAL(XMSTR,.XMTVAL)
- End DoDot:1
- +6 WRITE !,"<<< DONE >>>",!
- +7 if 'XMPASS
- DO FAIL
- +8 QUIT
- VAL(XMSTR,XMTVAL) ;
- +1 NEW XMLVAL,I
- +2 SET XMLVAL=0
- +3 FOR I=1:1:$LENGTH(XMSTR)
- SET XMLVAL=$ASCII(XMSTR,I)*I+XMLVAL
- +4 SET XMTVAL=XMTVAL+XMLVAL+$LENGTH(XMSTR)
- +5 QUIT
- CSCRAM(XMSTR) ;
- +1 SET XMB0=$SELECT(XMSTR'["TXT":1,1:0)
- +2 IF XMSTR["ROU"
- IF $PIECE(XMSTR," ",2)?1"^".AN1"NTEG"
- DO CNTEG
- QUIT
- +3 IF XMSTR'["$END"!($EXTRACT(XMSTR,1,8)="$END TXT"&'XMB0)
- SET XMTVAL=0
- SET XMA0=$PIECE(XMSTR," ",2)
- QUIT
- +4 WRITE "."
- IF $PIECE(XMSTR," ",2)="MESSAGE"
- QUIT
- +5 SET XMA0=$SELECT(XMSTR["$GLB":$PIECE(XMSTR,U,2),XMSTR["$GLO":$PIECE(XMSTR,U,2),1:$PIECE($PIECE(XMSTR,U)," ",3))
- +6 IF XMSTR["ROU"
- if $X>70
- WRITE !
- WRITE $JUSTIFY($EXTRACT(XMA0,1,9),10)
- +7 IF '$TEST
- WRITE !,$PIECE($EXTRACT(XMSTR,5,99),U)
- +8 ;CHECK SUM EVALUTAION
- +9 if $PIECE(XMSTR,U,2,999)=$$ENCSTR^XMJMCODE("$SEC"_U_(XMTVAL+XMPAKMAN("XMRW")))
- QUIT
- +10 WRITE !!,"******** ",$JUSTIFY(XMA0,10)," has failed !!!!!!!!!!!",!!
- +11 SET (XMTVAL,XMPASS)=0
- +12 QUIT
- FAIL ;
- +1 NEW XMTEXT,XMTO,XMFROM
- +2 if '$DATA(XMPASS)
- SET XMPASS=0
- +3 SET XMTEXT(1,0)="A package with the subject: "_$PIECE(^XMB(3.9,XMZ,0),U)
- +4 SET XMTEXT(2,0)="failed the security check during installation"_$SELECT($DATA(XMPASS):".",1:", but was installed anyway.")
- +5 SET XMFROM=$PIECE(^XMB(3.9,XMZ,0),U,2)
- +6 IF $GET(XMFROM)["<"
- SET XMTO(P($PIECE(XMFROM,"<",2),">"))=""
- +7 SET XMTO(XMDUZ)=""
- +8 DO SENDMSG^XMXSEND(XMDUZ,"Failed Security","XMTEXT",.XMTO)
- +9 QUIT
- CHECK ;FROM XMP2
- +1 if XCF'=2
- QUIT
- +2 IF "$DDD$RTN$DIE$DIB$DIP$ROU$GLB$GLO$OPT$HEL$BUL$KEY$PKG$FUN"[$EXTRACT(X,1,4)
- IF X[U
- Begin DoDot:1
- +3 if '$DATA(XMPASS)
- DO FAIL
- +4 SET X=$PIECE(X,U)_$PIECE(X,U,2)
- +5 if $PIECE(X," ",2)?.EU1"INIT"&($EXTRACT(X,1,4)="$ROU")
- SET XMINIT=U_$PIECE(X," ",2)
- End DoDot:1
- QUIT
- +6 IF $EXTRACT(X,1,12)="$END MESSAGE"
- IF '$DATA(XMPASS)
- DO FAIL
- +7 QUIT
- CNTEG ; Skip processing XXXINTEG program
- +1 SET XMINTEG=$PIECE(X," ",2)
- +2 FOR
- SET I=$ORDER(^XMB(3.9,XMZ,2,I))
- if 'I
- QUIT
- if "$END"[$EXTRACT(^(I,0),1,4)
- QUIT
- +3 QUIT
- PSECURE(XMZ,XMABORT) ; Secure the PackMan message
- +1 NEW XMKEY,XMHINT,XMNO,XMSECURE
- +2 SET XMABORT=0
- +3 DO PQSEC(.XMNO,.XMABORT)
- if XMNO!XMABORT
- QUIT
- +4 DO CRE8KEY^XMJMCODE(.XMKEY,.XMHINT,.XMABORT)
- if XMABORT
- QUIT
- +5 WRITE !!,"Securing the message now. This may take a while.",!
- +6 DO LOADCODE^XMJMCODE
- +7 DO ADJUST^XMJMCODE(.XMKEY)
- +8 DO PSTORE(XMZ,XMKEY,XMHINT)
- +9 DO PSECIT(XMZ)
- +10 QUIT
- PQSEC(XMOK,XMABORT) ;
- +1 NEW DIR,Y,X
- +2 SET DIR(0)="Y"
- +3 SET DIR("A")="Do you wish to secure this message"
- +4 SET DIR("B")="NO"
- +5 SET DIR("?",1)="If you answer yes, this message will be secured"
- +6 SET DIR("?")="to ensure that what you send is what is actually received."
- +7 DO ^DIR
- +8 IF $DATA(DIRUT)
- SET XMABORT=1
- +9 SET XMNO='Y
- +10 QUIT
- PSTORE(XMZ,XMKEY,XMHINT) ;
- +1 NEW XMFDA,XMIENS
- +2 SET XMIENS=XMZ_","
- +3 SET XMFDA(3.9,XMIENS,1.8)=$SELECT($GET(XMHINT)="":" ",1:XMHINT)
- +4 SET XMFDA(3.9,XMIENS,1.85)="1"_$$ENCSTR^XMJMCODE(XMKEY)
- +5 DO FILE^DIE("","XMFDA")
- +6 QUIT
- PSECIT(XMZ) ;
- +1 NEW XMSTR,I,XMTVAL
- +2 SET I=$ORDER(^XMB(3.9,XMZ,2,.999))
- +3 SET XMSTR=^XMB(3.9,XMZ,2,I,0)
- +4 SET XMSTR=$PIECE(XMSTR,"on")_"at "_$PIECE(XMSTR," at ",3)_" on"_$PIECE($PIECE(XMSTR,"on",2)," at",1)
- +5 SET ^XMB(3.9,XMZ,2,I,0)=XMSTR_U_$$ENCSTR^XMJMCODE("$SEC^3")
- +6 SET I=0
- +7 FOR
- SET I=$ORDER(^XMB(3.9,XMZ,2,I))
- if 'I
- QUIT
- Begin DoDot:1
- +8 ; naked reference to line above
- if '$DATA(^(I,0))
- QUIT
- +9 ; naked reference to line above
- SET XMSTR=^(0)
- +10 IF $EXTRACT(XMSTR)="$"
- DO PSCRAM(XMZ,.I,XMSTR,.XMTVAL)
- QUIT
- +11 DO VAL(XMSTR,.XMTVAL)
- End DoDot:1
- +12 SET XMSTR(1)="$END MESSAGE"
- +13 DO MOVEBODY^XMXSEND(XMZ,"XMSTR","A")
- +14 QUIT
- PSCRAM(XMZ,I,XMSTR,XMTVAL) ;
- +1 IF $EXTRACT(XMSTR,1,4)="$END"
- SET $PIECE(^XMB(3.9,XMZ,2,I,0),U,2)=$$ENCSTR^XMJMCODE("$SEC"_U_(XMTVAL+XMPAKMAN("XMRW")))
- QUIT
- +2 IF $EXTRACT(XMSTR,1,4)="$ROU"
- Begin DoDot:1
- +3 if $X>70
- WRITE !
- +4 WRITE $JUSTIFY($PIECE(XMSTR," ",2),10)
- End DoDot:1
- IF $PIECE(XMSTR," ",2)?.AN1"NTEG"
- DO PNTEG(XMZ,.I,XMSTR)
- QUIT
- +5 SET XMTVAL=0
- +6 SET $PIECE(^XMB(3.9,XMZ,2,I,0)," ",2)=$SELECT($EXTRACT(XMSTR,1,4)'="$KID":U,1:"")_$PIECE(XMSTR," ",2)
- +7 QUIT
- PNTEG(XMZ,I,XMSTR) ;
- +1 SET $PIECE(^XMB(3.9,XMZ,2,I,0)," ",2)=U_$PIECE(XMSTR," ",2)
- +2 FOR
- SET I=$ORDER(^XMB(3.9,XMZ,2,I))
- if 'I
- QUIT
- SET XMSTR=^(I,0)
- if "$END"[$EXTRACT(XMSTR_" ",1,4)
- QUIT
- Begin DoDot:1
- +3 if XMSTR?.UN1" ;;".N
- SET $PIECE(^XMB(3.9,XMZ,2,I,0),";",3)=$$ENCSTR^XMJMCODE($PIECE(XMSTR,";",3)+XMPAKMAN("XMRW"))
- End DoDot:1
- +4 QUIT