source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUSSPKI.m@ 1521

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

initial load of WorldVistAEHR
File size: 3.4 KB
Line 
1XUSSPKI ;ISF/RWF - Kernel Security Services PKI ;02/04/2003 13:19
2 ;;8.0;KERNEL;**283**;Jul 10, 1995
3 ;;
4 Q ;No entry from top
5 ;Supported by IA # 3539
6 ;This is a M api to store the Digital Signature in file 8980.2
7STORESIG(XU1,XU2,XU3,XU4,XU5) ;Store the signature.
8 ;XU1 is the hash
9 ;XU2 is the string length
10 ;XU3 is an array for the sig
11 ;XU4 is the DUZ of the signer
12 ;XU5 is the file that holds the data.
13 ;Returns 1 if filed OK, "-1^message" if an error.
14 N FDA,IEN,CNT,ROOT
15 I $$FIND1^DIC(8980.2,,"X",XU1)>0 Q "-1^Dup Hash"
16 I $G(XU4)<.5 Q "-1^No DUZ"
17 I $G(XU5)="" Q "-1^No File Number"
18 S CNT=0,ROOT="XU3"
19 F S ROOT=$Q(@ROOT) Q:ROOT="" S CNT=CNT+$L(@ROOT)
20 I CNT'=XU2 Q "-1^BAD SIG LENGTH"
21 S FDA(8980.2,"+1,",.01)=XU1
22 S FDA(8980.2,"+1,",.02)=XU2
23 S FDA(8980.2,"+1,",.03)=XU4
24 S FDA(8980.2,"+1,",.04)=XU5
25 S FDA(8980.2,"+1,",1)="XU3"
26 D UPDATE^DIE("S","FDA","IEN")
27 I $D(^TMP("DIERR",$J)) Q "-1^DBS Error"
28 Q 1
29 ;
30 ;Supported by IA # 3539
31CRLURL(XU1) ;Store the URL for the CRL
32 ;Store each URL as a separte record
33 N FDA,IEN,CNT,NOW,X,Y,ERR
34 S ERR=0,NOW=$$NOW^XLFDT
35 F CNT=1:1 S X=$P(XU1,$C(9),CNT) Q:X="" D
36 . S Y=$$LOW^XLFSTR($E(X,1,4))
37 . I '((Y="http")!(Y="ldap")) Q
38 . S FDA(8980.22,"?+"_CNT_",",.01)=X
39 . S FDA(8980.22,"?+"_CNT_",",1)=NOW
40 . D UPDATE^DIE("S","FDA","IEN")
41 . I $D(^TMP("DIERR",$J)) S ERR=1
42 . Q
43 Q $S('ERR:1,1:"-1^DBS Error")
44 ;
45 ;Supported by IA # 3539
46VERIFY(XU1,XU2,XU3) ;Veryify the data
47 ;The HASH is in XU1
48 ;The data root is in XU2
49 ;(optional) Date to check against
50 N CNT,IEN,SD,DR,R,V,ZX K ^TMP("PKI",$J),^TMP("pki",$J)
51 S IEN=$$FIND1^DIC(8980.2,,"X",XU1)
52 I IEN'>0 Q "-1^FAIL TO FIND HASH"
53 S CNT=0,SD=$NA(^TMP("PKI",$J)),DR=$E(XU2,1,$L(XU2)-1)
54 ;Load the data into the buffer
55 F S XU2=$Q(@XU2) Q:XU2'[DR S V=@XU2 I $L(V) D ADD(V)
56 D ADD("") ;Blank line between
57 ;Load the Digital Signature into the buffer
58 F I=1:1 Q:'$D(^XUSSPKI(8980.2,IEN,1,I,0)) S V=^(0) I $L(V) D ADD(V)
59 ;Then a Blank line and the Date.
60 D ADD(""),ADD($G(XU3))
61 ;Send the buffer
62 S S=$$EN^XUSC1("DSIG",SD,$NA(ZX))
63 S R=$S(S<0:S,1:ZX(1))
64 Q R
65ADD(V) ;Add to the send array
66 S CNT=CNT+1,@SD@(CNT)=V
67 Q
68 ;
69CRLUP ;Send any unsent CRL URL's to the server
70 ;Server port is 10270
71 L ^XUSSPKI(8980.22,"AC"):1 I '$T Q ;Busy
72 N CNT,SD,FDA,IEN,LIM,NOW,X1,X2,X3 K ^TMP("PKI",$J),^TMP("XUSSPKI",$J)
73 ;Only send for 300 days past last seen date
74 S X1=0,LIM=$$HTFM^XLFDT($H-300),CNT=0,NOW=$$NOW^XLFDT
75 S SD=$NA(^TMP("PKI",$J)),FDA=$NA(^TMP("XUSSPKI",$J))
76 F S X1=$O(^XUSSPKI(8980.22,X1)) Q:X1="" D
77 . S X2=$G(^XUSSPKI(8980.22,X1,0)),X2(1)=$P(X2,U,1),X2(2)=$P(X2,U,2),X2(3)=$P(X2,U,3) Q:'$L(X2(1))
78 . ;Only send http for now
79 . I "http:"'=$$LOW^XLFSTR($E(X2,1,5)) Q
80 . ;Check last seen, Last sent more than 3 hours ago.
81 . I (X2(2)<LIM)!($$FMDIFF^XLFDT(NOW,X2(3),2)<10800) Q
82 . D ADD(X2(1)) S @FDA@("8980.22",X1_",",2)=NOW
83 . Q
84 S S=-1 ;Init var, CNT update in ADD
85 ;Send the buffer of CRL URL's
86 I CNT D
87 . S S=$$EN^XUSC1("CRL ",SD,$NA(X3))
88 . S @SD@("Result")=S_"^"_$G(X3(1))
89 . S S=$S(S<0:S,$G(X3(1))'="OK":"-3^"_$G(X3(1)),1:S)
90 I CNT,(S<0) D
91 . N XMB,XMY,XMTEXT,XMDUZ S XMB(1)=S,XMB(2)=$$FMTE^XLFDT(NOW),XMDUZ="CRL Upload Task"
92 . S XMB="XUSSPKI CRL SERVER" D ^XMB
93 . Q
94 I S'<0 D
95 . D FILE^DIE("K",FDA)
96 Q
97TESTCRL ;TEST CRLUP
98 N FDA,LUD
99 S DA=0,RT=$NA(^XUSSPKI(8980.22)),LUD=$$HTFM^XLFDT(+$H_",120")
100 F S DA=$O(@RT@(DA)) Q:DA'>0 S FDA(8980.22,DA_",",2)=LUD
101 D FILE^DIE("K","FDA")
102 D CRLUP
103 W "Result: ",$G(^TMP("PKI",$J,"Result"))
104 Q
Note: See TracBrowser for help on using the repository browser.