Ticket #11: VWHSH.ro

Jan 08 2010
GT.M 08-JAN-2010 21:12:13
VWHSH0
VWHSH0 ;;GpZ; - ; IMPROVED HASHING UTILITY: MAIN INSTALL MODULE; 01/08/2010
V ;;8.0;KERNEL;;Jul 10, 1995
 ;; VWHSH
CHECK ;;
 N %S,%D,%ZR,HSH,HASH,HASHLIST,MUMPS,OS,PATH,SCR,ZTOS
 S HASH=$P($G(^%ZOSF("HASHLIST")),"|")  ; ID installed HASH from earlier version.
 S HASH=$S($$EN^XUSHSH("TEST")="TEST":"NONE",$L($G(HASH))>0:HASH,1:"LEGACY")  ; query current XUSHSH
 DO DEFHASH
 IF HASHLIST'[" MD5 " S ABORT="gpg FAILURE; CHECK for gnupg dependency & its PATH" GOTO ABORT
 S %S=$S(ZTOS=8:"VWHSHGTM",HASHLIST["Linux":"VWHSHCLX",1:"VWHSHCWN")
 S %D="XUSHSH",U="^",SCR="I 1"
 IF $T(^VWHSHLEG)="" S %S="XUSHSH^"_%S,%D="VWHSHLEG^"_%D
 ; preserve old ^XUSHSH as ^VWHSHLEG
 S U="^",SCR="I 1"
 DO MOVE^ZTMGRSET
 QUIT
 ;
DEFHASH ;; Entry point for changing default hash.
 IF '$L($G(HASH)) DO
 . S HASH=$P($G(^%ZOSF("HASHLIST")),"|")
 . QUIT:$L($G(HASH))
 . S:$T(^VWHSHLEG)>"" HASH=$S($$EN^VWHSHLEG("TEST")="TEST":"NONE",1:"LEGACY")
 . QUIT:$L($G(HASH))
 . S HASH="LEGACY"  ; hard-coded default hash is LEGACY
 . QUIT
 S HASH=$TR(HASH,"abcdefghijklmnopqrstuvwxyz- ","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
 S MUMPS=^%ZOSF("OS"),ZTOS=$S(MUMPS["GT.M":8,MUMPS["OpenM":3)
 ; SHOULD ERROR IF neither GTM nor Cache.
 S HASHLIST=HASH_"||"_$$INIT^@("VWHSH"_ZTOS)()
 S ^%ZOSF("HASHLIST")=HASHLIST
 QUIT
 ;
ABORT ;; Failed to find gpg hashes.
 U 0 W !,ABORT,! W $G(^%ZOSF("HASHLIST")),!

VWHSH3
VWHSH3 ;;GpZ; - ; IMPROVED HASHING UTILITY: INSTALL MODULE, OpenM; 01/08/2010
V ;;8.0;KERNEL;;Jul 10, 1995
 ;
 QUIT
 ;
INIT() S MUMPS=^%ZOSF("OS"),OS=$$OPENM("uname -o","Linux")
 IF OS'["Linux" S OS=$$OPENM("Ver","Microsoft") DO
 . S PIPE="PATH"
 . OPEN PIPE:"Q" USE PIPE READ PATH CLOSE PIPE
 . S PATH=PATH_";C:\""Program Files""\GNU\GnuPG\"
 . F I=1:1:$L(PATH,";") Q:($P(PATH,";",I)["GnuPG")
 . S PATH=$P(PATH,";",I)
 ELSE  S PATH=$P($P($$OPENM("whereis gpg","gpg")," ",2),"gpg")
 S ZUT=$ZUTIL(68,40,1)
 S PIPE=$G(PATH)_"gpg --version"
 OPEN PIPE:"Q"
 F I=1:1:20 USE PIPE R HASHLIST QUIT:$ZEOF<0  D:HASHLIST["'gpg' is not recognized"  q:HASHLIST["Hash:"
 . S HASHLIST="Hash:gpg_not_found:gpg_HASHES_not_available"
 CLOSE PIPE
 S ZUT=$ZUTIL(68,40,ZUT)
 S HASHLIST=HASHLIST
 S HASHLIST=$TR($P(HASHLIST,"Hash:",2),",")
 S HASHLIST=HASHLIST_" ||"_PATH_"||"_MUMPS_OS_"||"
 QUIT HASHLIST
 ;
OPENM(PIPE,SEEKING) ;;
 N (PIPE,SEEKING)
 S ZUT=$ZUTIL(68,40,1)
 OPEN PIPE:"Q"
 F I=1:1:4 USE PIPE READ X Q:$ZEOF<0  Q:X[SEEKING
 CLOSE PIPE
 S ZUT=$ZUTIL(68,40,ZUT)
 QUIT X

VWHSH8
VWHSH8 ;;GpZ; - ; IMPROVED HASHING UTILITY: INSTALL MODULE, GT.M; 01/08/2010
V ;;8.0;KERNEL;;Jul 10, 1995
 ;
 QUIT
 ;
INIT() S MUMPS=^%ZOSF("OS"),OS=$$GTM("uname -o")
 S PATH=$P($P($$GTM("whereis gpg")," ",2),"gpg")
 S X=$TR("host:"_MUMPS_OS_":","^ ","-")
 O "PIPE":(COMM="gpg --version|grep -E ^Hash:":READONLY)::"PIPE"
 U "PIPE" R HASHLIST
 C "PIPE" U 0
 S HASHLIST=$TR($P(HASHLIST,"Hash:",2),",")
 S HASHLIST=HASHLIST_" ||"_PATH_"||"_MUMPS_OS_"||"
 QUIT HASHLIST
 ;
GTM(PIPE) ;
 N (PIPE)
 OPEN "PIPE":(command=PIPE)::"pipe"
 S X="" F I=1:1:4 U "PIPE" R XX Q:$ZEOF  S X=X_XX
 CLOSE "PIPE"
 QUIT X

VWHSHCLX
XUSHSH ;;GpZ; - ; IMPROVED HASHING UTILITY: for Cache/Linux (VWHSHCLX); 01/08/2010
V ;;8.0;KERNEL;;Jul 10, 1995
 ;;
A S X=$$EN(X) Q
 ;;
EN(X,HASH) ;;
 N (X,HASH)
 D:'$L($G(^%ZOSF("HASHLIST"))) DEFHASH^VWHSH0
 S HASHLIST=^%ZOSF("HASHLIST")
 S HASH=$S('$L($G(HASH)):$P(HASHLIST,"|",1),1:$TR(HASH,"abcdefghijklmnopqrstuvwxyz- ","ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
 IF HASH="LEGACY" QUIT $$EN^VWHSHLEG(X)
 Q:HASHLIST'[(" "_HASH_" ") X
 S SED="sed -e 's/$/\r/'|"
 N PIPE,ZUT,I
 S ZUT=$ZUTIL(68,40,1)  ;; MSM-style End-of-File Handling
 S PIPE=" echo "_X_"||"_SED_$P(HASHLIST,"||",3)_"gpg --print-md "_HASH
 OPEN PIPE:"Q"
 F I=1:1:4 USE PIPE R X Q:$ZEOF<0  S HASHOUT=$G(HASHOUT)_X
 CLOSE PIPE
 S ZUT=$ZUTIL(68,40,ZUT),X=HASHOUT
 Q $TR(X," ")

VWHSHCWN
XUSHSH ;;GpZ;  ; IMPROVED HASHING UTILITY: Cache/Windows (VWHSHCWN);01/08/2010
V ;;8.0;KERNEL;;Jul 10, 1995
 ;;
A S X=$$EN(X) Q
 ;;
EN(X,HASH) ;;
 N (X,HASH)
 D:'$L($G(^%ZOSF("HASHLIST"))) DEFHASH^VWHSH0
 S HASHLIST=^%ZOSF("HASHLIST")
 S HASH=$S('$L($G(HASH)):$P(HASHLIST,"|",1),1:$TR(HASH,"abcdefghijklmnopqrstuvwxyz- ","ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
 IF HASH="LEGACY" QUIT $$EN^VWHSHLEG(X)
 Q:HASHLIST'[(" "_HASH_" ") X
 N PIPE,ZUT,I
 S ZUT=$ZUTIL(68,40,1)
 S PIPE=" echo "_X_"||"_$P(HASHLIST,"||",3)_"gpg --print-md "_HASH
 OPEN PIPE:"Q"
 F I=1:1:4 USE PIPE R X Q:$ZEOF<0  S HASHOUT=$G(HASHOUT)_X
 CLOSE PIPE
 S ZUT=$ZUTIL(68,40,ZUT),X=HASHOUT
 Q $TR(X," ")

VWHSHGTM
XUSHSH ;;GpZ; - ; IMPROVED HASHING UTILITY: GT.M Version (VWHSHGTM); 01/08/2010
V ;;8.0;KERNEL;;Jul 10, 1995
 ;;
A S X=$$EN(X) Q
 ;;
EN(X,HASH) ;;
 N (X,HASH)
 D:'$L($G(^%ZOSF("HASHLIST"))) DEFHASH^VWHSH0
 S HASHLIST=^%ZOSF("HASHLIST")
 S HASH=$S('$L($G(HASH)):$P(HASHLIST,"|",1),1:$TR(HASH,"abcdefghijklmnopqrstuvwxyz- ","ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
 IF HASH="LEGACY" QUIT $$EN^VWHSHLEG(X)
 Q:HASHLIST'[(" "_HASH_" ") X
 S SED="sed -e 's/$/\r/'|"
 OPEN "PIPE":(COMM=SED_"gpg --print-md "_HASH)::"PIPE"
 USE "PIPE" W X,! W /EOF
 F  R X Q:$ZEOF  S HASHOUT=$G(HASHOUT)_X
 CLOSE "PIPE"
 Q $TR(HASHOUT," ")

VWHSTEST
XUSHSH ;JL.Z; ROBUST PASSWORD HASH TEST xushsh; 11 SEPTEMBER 2009
 ;; Test routine to provide a strawman version ^XUSHSH
 ;;8.0;KERNEL;**60**;Jul 10, 1995
 ;;
 ;;
 ;;SF-ISC/STAFF - PASSWORD ENCRYPTION ;3/23/89  15:09 ; 4/14/05 1:22pm
 ;;8.0;KERNEL;;Jul 10, 1995
 ;; Input in X
 ;; Output in X
 ;; Algorithm for VistA Office EHR encryption (BSL)
A ;
 S X=$$EN(X)
 Q
 ;
EN(X)
 Q X