- ZIBRPI ; IHS/ADC/GTH - REMOTE PATCH INSTALLATION ; [ 11/04/97 10:26 AM ]
- ;;3.0;IHS/VA UTILITIES;**1,2,3**;FEB 07, 1997
- ; XB*3*1 IHS/ADC/GTH 03-07-97 Correct spelling of uucppublic.
- ; XB*3*2 IHS/ADC/GTH 04-21-97 Correct patch file pattern match.
- ; XB*3*3 IHS/ADC/GTH 04-25-97 Correct patch file name handling.
- ;
- ; For a description of this utility, see the text in routine
- ; ZIBRPI2.
- ;
- ; D = Directory containing patch files
- ; D("OUT") = Directory with results files
- ; E = "Action" routine, named (A/B)9<namespace><patch_number>
- ; F = Name of a file containing a patch
- ; J = Today's Julian date
- ; L = Facility's Pseudo Prefix
- ; N = Namespace derived from the name of the file
- ; O = Operating System, and OS-specific commands
- ; P = PACKAGE file IEN
- ; V = Version derived from the name of the file
- ; W = Work file
- ;
- W !!,"EXECUTION UNAUTHORIZED.",!
- Q
- ;
- OPT ;EP - Set option in OPTION file. Called by a programmer.
- D OPT^ZIBRPI1
- Q
- ;
- START ;EP - From TaskMan.
- NEW %ZIS,D,DA,DIC,E,F,I,J,L,N,O,P,POP,V,W,XMSUB,XMTEXT,XMY
- D HFS
- Q:POP
- D OS
- KILL ^TMP($J)
- ; rm xmit files over 2 weeks old.
- S L=$P(^AUTTLOC($P(^AUTTSITE(1,0),U),1),U,2) I '($L(L)=3) S L="RPI"
- D HC(O("LS")_D("OUT")_O("NS")_L_".* > "_W)
- S IOP=I,%ZIS("IOPAR")="("""_W_""":""R"")"
- D ZIS,JDT
- U IO
- ; Comment next line to keep xmit ("rpi") files over 2 wks old.
- F R %:300 Q:%="" S %=$P(%,"/",$L(%,"/")),X=+$P(%,".",2) I $P(%,".")=O("NS")_L,((+X>+J)!(+X<(+J-14))) D HC(O("RM")_D("OUT")_%)
- D HC(O("RM")_W)
- ; Initialize namespace, systems, and frequency.
- S %=+$P(^DIC(19,$O(^DIC(19,"B","ZIB REMOTE PATCH INSTALLATION",0)),20)," ",2),D=$P($P(^(20),"""",2),U)
- S:'("/\"[$E(D,$L(D))) D=D_$S(O["UNIX":"/",1:"\")
- D HC(O("LS")_D_"*.*"_" > "_W)
- S IOP=I,%ZIS("IOPAR")="("""_W_""":""R"")"
- D ZIS
- U IO
- ; The Q:%="" in the following line is non-standard MUMPS.
- F R %:300 Q:%="" S %=$P(%,"/",$L(%,"/")) I %?@O("PF") S ^TMP($J,"ZIBRPI",%)=""
- S F=""
- I '$L($O(^TMP($J,"ZIBRPI",""))) D ZISC D HC(O("RM")_W) KILL ^TMP($J) S:$D(ZTQUEUED) ZTREQ="@" Q
- MAIN ;
- F S F=$O(^TMP($J,"ZIBRPI",F)) Q:F="" D S ^TMP($J,"ZIBRPI",F)=% D:%="INSTALLED" HC(O("RM")_D_F)
- . S X=$E(F,1,4),X=$P(X,"_"),N=$$UP^XLFSTR(X)
- . I '$D(^DIC(9.4,"C",N)) S %="FAILED - Not an Installed Package" Q
- . S P=$O(^DIC(9.4,"C",N,0))
- . I 'P S %="FAILED - Bad ""C"" x-ref for "_N Q
- . I '$D(^DIC(9.4,P,"VERSION")) S %="FAILED - 'VERSION' Node Missing" Q
- . S V=+($E(F,5,6)_"."_$E(F,7,8))
- . I (+V)'=(+^DIC(9.4,P,"VERSION")) S %="FAILED - V "_^("VERSION")_" of "_N_" is Installed" Q
- . ; S E=$S("AB"[$E(N):$E(N),1:"B")_"9"_N_$P($P(F,".",2),"p",2) ; XB*3*3 IHS/ADC/GTH 04-25-97 Correct patch file name handling.
- . S E=$S("AB"[$E(N):$E(N),1:"B")_"9"_N_(+$P($P(F,".",2),"p",1)) ; XB*3*3 IHS/ADC/GTH 04-25-97 Correct patch file name handling.
- . U IO:(D_F)
- . R %:300
- . R %:300
- . ; The ZL and ZS in the following line are non-standard M commands.
- . F R %:300 Q:%="" S:%=E ^TMP($J,"B9",%)="" X "ZL ZS @%"
- . S DA(1)=^DIC(9.4,P,"VERSION"),DA(1)=$O(^DIC(9.4,P,22,"B",DA(1)_$S(DA(1)[".":"",1:".0"),0))
- . I 'DA(1) S DA(1)=$P(^DIC(9.4,P,22,0),U,3)
- . S:'$D(^DIC(9.4,P,22,DA(1),"PAH",0)) ^(0)="^9.4901^^"
- . ; S X=N_"*"_V_"*"_$P($P(F,".",2),"p",2),DIC="^DIC(9.4,"_P_",22,"_DA(1)_",""PAH"",",DIC(0)="",DIC("DR")=".02///"_DT_";.03///.5",DA(2)=P ; XB*3*3 IHS/ADC/GTH 04-25-97 Correct patch file name handling.
- . S X=N_"*"_V_"*"_(+$P($P(F,".",2),"p",1)),DIC="^DIC(9.4,"_P_",22,"_DA(1)_",""PAH"",",DIC(0)="",DIC("DR")=".02///"_DT_";.03///.5",DA(2)=P ; XB*3*3 IHS/ADC/GTH 04-25-97 Correct patch file name handling.
- . D FILE
- . S %="INSTALLED"
- . Q
- ENDMAIN ;
- D OS
- S %=0,F="",D=D("OUT")_O("NS")_L_"."_J
- U IO:(D:"W")
- F S F=$O(^TMP($J,"ZIBRPI",F)) Q:F="" W L,U,F,U,^(F),U,DT,! S %=%+1,XMTEXT(%)="Restore from file "_$E(F_$J("",14),1,14)_": "_^(F)
- U IO:(W)
- D ZISC,HC(O("RM")_W)
- ; uucp according to parameter: ENTRY ACTION of option.
- S %=+$P(^DIC(19,$O(^DIC(19,"B","ZIB REMOTE PATCH INSTALLATION",0)),20)," ",2),E=$P($P(^(20),"""",2),U,2)
- I O["UNIX" D
- . I '(%=2) D HC("uucp -r "_D_" "_$P($T(SYTM),";",3)_"!~")
- . I %>1 D HC("uucp -r -nroot "_D_" "_$P(^AUTTSITE(1,0),U,14)_"!~")
- . Q
- S XMTEXT="XMTEXT(",XMSUB=$P($P($T(ZIBRPI),";",2),"-",2),XMY(1)=""
- D XMD
- I E S %="" F S %=$O(^TMP($J,"B9",%)) Q:%="" D RTN(U_%)
- KILL ^TMP($J)
- S ZTREQ="@"
- Q ;
- Q
- ;
- DIE NEW D,E,F,I,J,L,N,O,P,V,W D ^DIE Q
- DIR NEW D,E,F,I,J,L,N,O,P,V,W D ^DIR Q
- DTC NEW D,E,F,I,J,L,N,O,P,V,W D ^%DTC Q
- FILE NEW D,E,F,I,J,L,N,O,P,V,W KILL DD,DO D FILE^DICN Q
- HC(%) NEW D,E,F,I,J,L,N,O,P,V,W S %=$$JOBWAIT^%HOSTCMD(%) Q
- RTN(%) NEW D,E,F,I,J,L,N,O,P,V,W D @(%) Q
- XMD NEW D,E,F,I,J,L,N,O,P,V,W D ^XMD Q
- ZIS NEW D,E,F,I,J,L,N,O,P,V,W D ^%ZIS Q
- ZISC NEW D,E,F,I,J,L,N,O,P,V,W D ^%ZISC Q
- ;
- HFS ;
- ; F I=0:0 S I=$O(^%ZIS(1,I)) Q:'I I ^(I,"TYPE")="HFS" S IOP=$P(^%ZIS(1,I,0),U),%ZIS("IOPAR")="(""/usr/spool/uucpublic/work.zib"":""W"")" D ZIS Q:'POP ; XB*3*1 IHS/ADC/GTH 03-07-97 Correct spelling of uucppublic.
- F I=0:0 S I=$O(^%ZIS(1,I)) Q:'I I ^(I,"TYPE")="HFS" S IOP=$P(^%ZIS(1,I,0),U),%ZIS("IOPAR")="(""/usr/spool/uucppublic/work.zib"":""W"")" D ZIS Q:'POP ; XB*3*1 IHS/ADC/GTH 03-07-97 Correct spelling of uucppublic.
- I 'I,'$D(POP) S POP=1
- Q:POP
- S I=$P(^%ZIS(1,I,0),U)
- Q
- ;
- JDT ;
- NEW X1,X2
- S X2=$E(DT,1,3)_"0101",X1=DT
- D DTC
- S X=X+1,X="00"_X,J=$E(X,$L(X)-2,$L(X))
- Q
- ;
- OS ; The "IN" directory is retrieved from the OPTION entry.
- S O=$P($P(^%ZOSF("OS"),","),"-",2),O("PF")=$P($T(PATTERN),";",3)
- S W=$P($T(WORK),";",3),O("NS")=$P($T(NS),";",3)
- I O["UNIX" S (D("IN"),D("OUT"))=$P($T(PUB),";",3),O("RM")="rm ",O("LS")="ls -l ",W=D("OUT")_W Q
- S %=$G(^AUTTSITE(1,1)),D("IN")=$P(%,U),D("OUT")=$P(%,U,2),O("RM")="DEL ",O("LS")="DIR /B "
- Q
- ;
- ; XB*3*2 IHS/ADC/GTH 04-21-97 Correct patch file pattern match.
- ; Old PATTERN:
- ;;2.4L.2"_"4N1"."1"p"1.2N
- SYTM ;;dpssyg
- PATTERN ;;2.4L.2"_"4N1"."1.2N1"p"; XB*3*2 IHS/ADC/GTH 04-21-97 Correct patch file pattern match.
- WORK ;;ZIBRPI.WRK
- PUB ;;/usr/spool/uucppublic/
- NS ;;ZIB_P
- ZIBRPI ; IHS/ADC/GTH - REMOTE PATCH INSTALLATION ; [ 11/04/97 10:26 AM ]
- +1 ;;3.0;IHS/VA UTILITIES;**1,2,3**;FEB 07, 1997
- +2 ; XB*3*1 IHS/ADC/GTH 03-07-97 Correct spelling of uucppublic.
- +3 ; XB*3*2 IHS/ADC/GTH 04-21-97 Correct patch file pattern match.
- +4 ; XB*3*3 IHS/ADC/GTH 04-25-97 Correct patch file name handling.
- +5 ;
- +6 ; For a description of this utility, see the text in routine
- +7 ; ZIBRPI2.
- +8 ;
- +9 ; D = Directory containing patch files
- +10 ; D("OUT") = Directory with results files
- +11 ; E = "Action" routine, named (A/B)9<namespace><patch_number>
- +12 ; F = Name of a file containing a patch
- +13 ; J = Today's Julian date
- +14 ; L = Facility's Pseudo Prefix
- +15 ; N = Namespace derived from the name of the file
- +16 ; O = Operating System, and OS-specific commands
- +17 ; P = PACKAGE file IEN
- +18 ; V = Version derived from the name of the file
- +19 ; W = Work file
- +20 ;
- +21 WRITE !!,"EXECUTION UNAUTHORIZED.",!
- +22 QUIT
- +23 ;
- OPT ;EP - Set option in OPTION file. Called by a programmer.
- +1 DO OPT^ZIBRPI1
- +2 QUIT
- +3 ;
- START ;EP - From TaskMan.
- +1 NEW %ZIS,D,DA,DIC,E,F,I,J,L,N,O,P,POP,V,W,XMSUB,XMTEXT,XMY
- +2 DO HFS
- +3 IF POP
- QUIT
- +4 DO OS
- +5 KILL ^TMP($JOB)
- +6 ; rm xmit files over 2 weeks old.
- +7 SET L=$PIECE(^AUTTLOC($PIECE(^AUTTSITE(1,0),U),1),U,2)
- IF '($LENGTH(L)=3)
- SET L="RPI"
- +8 DO HC(O("LS")_D("OUT")_O("NS")_L_".* > "_W)
- +9 SET IOP=I
- SET %ZIS("IOPAR")="("""_W_""":""R"")"
- +10 DO ZIS
- DO JDT
- +11 USE IO
- +12 ; Comment next line to keep xmit ("rpi") files over 2 wks old.
- +13 FOR
- READ %:300
- IF %=""
- QUIT
- SET %=$PIECE(%,"/",$LENGTH(%,"/"))
- SET X=+$PIECE(%,".",2)
- IF $PIECE(%,".")=O("NS")_L
- IF ((+X>+J)!(+X<(+J-14)))
- DO HC(O("RM")_D("OUT")_%)
- +14 DO HC(O("RM")_W)
- +15 ; Initialize namespace, systems, and frequency.
- +16 SET %=+$PIECE(^DIC(19,$ORDER(^DIC(19,"B","ZIB REMOTE PATCH INSTALLATION",0)),20)," ",2)
- SET D=$PIECE($PIECE(^(20),"""",2),U)
- +17 IF '("/\"[$EXTRACT(D,$LENGTH(D)))
- SET D=D_$SELECT(O["UNIX":"/",1:"\")
- +18 DO HC(O("LS")_D_"*.*"_" > "_W)
- +19 SET IOP=I
- SET %ZIS("IOPAR")="("""_W_""":""R"")"
- +20 DO ZIS
- +21 USE IO
- +22 ; The Q:%="" in the following line is non-standard MUMPS.
- +23 FOR
- READ %:300
- IF %=""
- QUIT
- SET %=$PIECE(%,"/",$LENGTH(%,"/"))
- IF %?@O("PF")
- SET ^TMP($JOB,"ZIBRPI",%)=""
- +24 SET F=""
- +25 IF '$LENGTH($ORDER(^TMP($JOB,"ZIBRPI","")))
- DO ZISC
- DO HC(O("RM")_W)
- KILL ^TMP($JOB)
- IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- QUIT
- MAIN ;
- +1 FOR
- SET F=$ORDER(^TMP($JOB,"ZIBRPI",F))
- IF F=""
- QUIT
- Begin DoDot:1
- +2 SET X=$EXTRACT(F,1,4)
- SET X=$PIECE(X,"_")
- SET N=$$UP^XLFSTR(X)
- +3 IF '$DATA(^DIC(9.4,"C",N))
- SET %="FAILED - Not an Installed Package"
- QUIT
- +4 SET P=$ORDER(^DIC(9.4,"C",N,0))
- +5 IF 'P
- SET %="FAILED - Bad ""C"" x-ref for "_N
- QUIT
- +6 IF '$DATA(^DIC(9.4,P,"VERSION"))
- SET %="FAILED - 'VERSION' Node Missing"
- QUIT
- +7 SET V=+($EXTRACT(F,5,6)_"."_$EXTRACT(F,7,8))
- +8 IF (+V)'=(+^DIC(9.4,P,"VERSION"))
- SET %="FAILED - V "_^("VERSION")_" of "_N_" is Installed"
- QUIT
- +9 ; S E=$S("AB"[$E(N):$E(N),1:"B")_"9"_N_$P($P(F,".",2),"p",2) ; XB*3*3 IHS/ADC/GTH 04-25-97 Correct patch file name handling.
- +10 ; XB*3*3 IHS/ADC/GTH 04-25-97 Correct patch file name handling.
- SET E=$SELECT("AB"[$EXTRACT(N):$EXTRACT(N),1:"B")_"9"_N_(+$PIECE($PIECE(F,".",2),"p",1))
- +11 USE IO:(D_F)
- +12 READ %:300
- +13 READ %:300
- +14 ; The ZL and ZS in the following line are non-standard M commands.
- +15 FOR
- READ %:300
- IF %=""
- QUIT
- IF %=E
- SET ^TMP($JOB,"B9",%)=""
- XECUTE "ZL ZS @%"
- +16 SET DA(1)=^DIC(9.4,P,"VERSION")
- SET DA(1)=$ORDER(^DIC(9.4,P,22,"B",DA(1)_$SELECT(DA(1)[".":"",1:".0"),0))
- +17 IF 'DA(1)
- SET DA(1)=$PIECE(^DIC(9.4,P,22,0),U,3)
- +18 IF '$DATA(^DIC(9.4,P,22,DA(1),"PAH",0))
- SET ^(0)="^9.4901^^"
- +19 ; S X=N_"*"_V_"*"_$P($P(F,".",2),"p",2),DIC="^DIC(9.4,"_P_",22,"_DA(1)_",""PAH"",",DIC(0)="",DIC("DR")=".02///"_DT_";.03///.5",DA(2)=P ; XB*3*3 IHS/ADC/GTH 04-25-97 Correct patch file name handling.
- +20 ; XB*3*3 IHS/ADC/GTH 04-25-97 Correct patch file name handling.
- SET X=N_"*"_V_"*"_(+$PIECE($PIECE(F,".",2),"p",1))
- SET DIC="^DIC(9.4,"_P_",22,"_DA(1)_",""PAH"","
- SET DIC(0)=""
- SET DIC("DR")=".02///"_DT_";.03///.5"
- SET DA(2)=P
- +21 DO FILE
- +22 SET %="INSTALLED"
- +23 QUIT
- End DoDot:1
- SET ^TMP($JOB,"ZIBRPI",F)=%
- IF %="INSTALLED"
- DO HC(O("RM")_D_F)
- ENDMAIN ;
- +1 DO OS
- +2 SET %=0
- SET F=""
- SET D=D("OUT")_O("NS")_L_"."_J
- +3 USE IO:(D:"W")
- +4 FOR
- SET F=$ORDER(^TMP($JOB,"ZIBRPI",F))
- IF F=""
- QUIT
- WRITE L,U,F,U,^(F),U,DT,!
- SET %=%+1
- SET XMTEXT(%)="Restore from file "_$EXTRACT(F_$JUSTIFY("",14),1,14)_": "_^(F)
- +5 USE IO:(W)
- +6 DO ZISC
- DO HC(O("RM")_W)
- +7 ; uucp according to parameter: ENTRY ACTION of option.
- +8 SET %=+$PIECE(^DIC(19,$ORDER(^DIC(19,"B","ZIB REMOTE PATCH INSTALLATION",0)),20)," ",2)
- SET E=$PIECE($PIECE(^(20),"""",2),U,2)
- +9 IF O["UNIX"
- Begin DoDot:1
- +10 IF '(%=2)
- DO HC("uucp -r "_D_" "_$PIECE($TEXT(SYTM),";",3)_"!~")
- +11 IF %>1
- DO HC("uucp -r -nroot "_D_" "_$PIECE(^AUTTSITE(1,0),U,14)_"!~")
- +12 QUIT
- End DoDot:1
- +13 SET XMTEXT="XMTEXT("
- SET XMSUB=$PIECE($PIECE($TEXT(ZIBRPI),";",2),"-",2)
- SET XMY(1)=""
- +14 DO XMD
- +15 IF E
- SET %=""
- FOR
- SET %=$ORDER(^TMP($JOB,"B9",%))
- IF %=""
- QUIT
- DO RTN(U_%)
- +16 KILL ^TMP($JOB)
- +17 SET ZTREQ="@"
- Q ;
- +1 QUIT
- +2 ;
- DIE NEW D,E,F,I,J,L,N,O,P,V,W
- DO ^DIE
- QUIT
- DIR NEW D,E,F,I,J,L,N,O,P,V,W
- DO ^DIR
- QUIT
- DTC NEW D,E,F,I,J,L,N,O,P,V,W
- DO ^%DTC
- QUIT
- FILE NEW D,E,F,I,J,L,N,O,P,V,W
- KILL DD,DO
- DO FILE^DICN
- QUIT
- HC(%) NEW D,E,F,I,J,L,N,O,P,V,W
- SET %=$$JOBWAIT^%HOSTCMD(%)
- QUIT
- RTN(%) NEW D,E,F,I,J,L,N,O,P,V,W
- DO @(%)
- QUIT
- XMD NEW D,E,F,I,J,L,N,O,P,V,W
- DO ^XMD
- QUIT
- ZIS NEW D,E,F,I,J,L,N,O,P,V,W
- DO ^%ZIS
- QUIT
- ZISC NEW D,E,F,I,J,L,N,O,P,V,W
- DO ^%ZISC
- QUIT
- +1 ;
- HFS ;
- +1 ; F I=0:0 S I=$O(^%ZIS(1,I)) Q:'I I ^(I,"TYPE")="HFS" S IOP=$P(^%ZIS(1,I,0),U),%ZIS("IOPAR")="(""/usr/spool/uucpublic/work.zib"":""W"")" D ZIS Q:'POP ; XB*3*1 IHS/ADC/GTH 03-07-97 Correct spelling of uucppublic.
- +2 ; XB*3*1 IHS/ADC/GTH 03-07-97 Correct spelling of uucppublic.
- FOR I=0:0
- SET I=$ORDER(^%ZIS(1,I))
- IF 'I
- QUIT
- IF ^(I,"TYPE")="HFS"
- SET IOP=$PIECE(^%ZIS(1,I,0),U)
- SET %ZIS("IOPAR")="(""/usr/spool/uucppublic/work.zib"":""W"")"
- DO ZIS
- IF 'POP
- QUIT
- +3 IF 'I
- IF '$DATA(POP)
- SET POP=1
- +4 IF POP
- QUIT
- +5 SET I=$PIECE(^%ZIS(1,I,0),U)
- +6 QUIT
- +7 ;
- JDT ;
- +1 NEW X1,X2
- +2 SET X2=$EXTRACT(DT,1,3)_"0101"
- SET X1=DT
- +3 DO DTC
- +4 SET X=X+1
- SET X="00"_X
- SET J=$EXTRACT(X,$LENGTH(X)-2,$LENGTH(X))
- +5 QUIT
- +6 ;
- OS ; The "IN" directory is retrieved from the OPTION entry.
- +1 SET O=$PIECE($PIECE(^%ZOSF("OS"),","),"-",2)
- SET O("PF")=$PIECE($TEXT(PATTERN),";",3)
- +2 SET W=$PIECE($TEXT(WORK),";",3)
- SET O("NS")=$PIECE($TEXT(NS),";",3)
- +3 IF O["UNIX"
- SET (D("IN"),D("OUT"))=$PIECE($TEXT(PUB),";",3)
- SET O("RM")="rm "
- SET O("LS")="ls -l "
- SET W=D("OUT")_W
- QUIT
- +4 SET %=$GET(^AUTTSITE(1,1))
- SET D("IN")=$PIECE(%,U)
- SET D("OUT")=$PIECE(%,U,2)
- SET O("RM")="DEL "
- SET O("LS")="DIR /B "
- +5 QUIT
- +6 ;
- +7 ; XB*3*2 IHS/ADC/GTH 04-21-97 Correct patch file pattern match.
- +8 ; Old PATTERN:
- +9 ;;2.4L.2"_"4N1"."1"p"1.2N
- SYTM ;;dpssyg
- PATTERN ;;2.4L.2"_"4N1"."1.2N1"p"; XB*3*2 IHS/ADC/GTH 04-21-97 Correct patch file pattern match.
- WORK ;;ZIBRPI.WRK
- PUB ;;/usr/spool/uucppublic/
- NS ;;ZIB_P
