/usr/lib/x86_64-linux-gnu/fis-gtm/V6.3-000A_x86_64/_DSEWRAP.m is in fis-gtm-6.3-000a 6.3-000A-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ;
; Copyright 2012, 2013 Fidelity Information Services, Inc. ;
; ;
; This source code contains the intellectual property ;
; of its copyright holder(s), and is made available ;
; under a license. If you do not know the terms of ;
; the license, please stop and do not read further. ;
; ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
%DSEWRAP
%dsewrap
; Wrappers for DSE to avoid inadvertently making database changes
set $ETRAP="do errtrap^%DSEWRAP"
set $ecode=",U255," ; must call an entryref
quit:$quit 255 quit ; in case error trap does not end the call
DUMP(r,o,w,d) ; upper case wrapper for dump
new tmp
set tmp=$$dump(r,.o,w,d)
quit:$quit tmp quit
dump(reglist,output,what,detail) ; dump information
; reglist - comma separated list of regions, "*" (default) for all regions
; output - required variable passed by reference where output is returned
; what - optional information to dump - "fileheader" (default) is only option for now
; detail - optional default is basic information, "all" is full fileheader dump
; install an error handler if non exists
if 0=$length($ETRAP) new $ETRAP set $ETRAP="do errtrap^%DSEWRAP"
new cmd,dse,debug,error,gtmdist,i,io,isVMS,line,mod,nopipe,region,ver
; save previous $IO to restore once the routine has completed
set io=$io
if $data(%DSEWRAP("debug")) do
. set debug=$increment(%DSEWRAP("debug"))
. set debug(debug,"input","reglist")=$get(reglist)
. set debug(debug,"input","what")=$get(what)
. set debug(debug,"input","detail")=$get(detail)
;
; Determine if we can use PIPES or not AND where to find DSE
set ver=$tr($piece($zversion," ",2),"V-.",""),ver=$select(ver<1000:ver*10,1:$extract(ver,1,5))
set isVMS=$zversion["VMS"
set nopipe=((ver<53003)&($get(%DSEWRAP("forcenopipe"),0)))!isVMS,mod=$select(isVMS:"/",1:"-")
set gtmdist=$select(isVMS:"gtm$dist",1:"gtm_dist")
;
; Applicable regions list
set reglist=$$reglist($$FUNC^%UCASE($get(reglist,"*")),isVMS)
; What operation? for now, should be just "dump -fileheader [-all]"
if (0=$length($get(what)))!("fileheader"=$$FUNC^%LCASE($get(what))) set what=mod_"fileheader"
else set $ecode=",U254," quit:$quit 254 quit
if 0=$length($get(detail)) set detail=""
else if "all"=$$FUNC^%LCASE(detail) set detail=mod_"all"
else if $length(detail," ")>1 do
. set detail=$$^%MPIECE(detail," "," ")
. for i=1:1:$length(detail," ") if $piece(detail," ",i)'?1(1"/",1"-").A set $piece(detail," ",i)=mod_$piece(detail," ",i)
set cmd="dump "_what_" "_detail
; Use alternate GT.M version - only supported with pipes
if nopipe&$data(%DSEWRAP("alternate")) set $ecode=",U252," quit:$quit 252 quit
; DSE command to use
set dse=$get(%DSEWRAP("alternate"),$ztrnlnm(gtmdist)_"/dse")
if $data(debug) merge debug(debug,"outputreg")=reglist
if reglist="" set $ecode=",U251," quit:$quit 251 quit
; Drive DSE
if 0=nopipe set error=$$dsepipecmd(.output,reglist,dse,cmd)
else set error=$$dsefilecmd(.output,reglist,cmd,isVMS)
use io
if $data(%DSEWRAP("debug")) merge %DSEWRAP("debug")=debug
quit:$quit error quit
; drive DSE through a PIPE device
dsepipecmd(output,regionlist,dse,cmd)
new error,curreg
open "dseproc":(shell="/bin/sh":command=dse)::"pipe"
use "dseproc"
for curreg=2:1:$length(regionlist,",") do
. set region=$piece(regionlist,",",curreg)
. if ($length(region)=0)&($data(debug)) set debug(debug,"reg",curreg)="first"_$c(10)
. if $length(region)>0 do ; should be 0 only when curreg=2
. . write region,! if $data(debug) set debug(debug,"reg",curreg)=region_$c(10)
. . set error=$$parsefhead(.output,1)
. write cmd,! if $data(debug) set debug(debug,"reg",curreg)=$get(debug(debug,"reg",curreg))_cmd
. set error=$$parsefhead(.output,1)
write "exit",!
write /eof
set error=$$parsefhead(.output,1)
close "dseproc"
quit error
; when PIPE devices are not supported drive DSE via a HEREDOC in a script
dsefilecmd(output,regionlist,cmd,isVMS)
new scriptfile,dsecmd,dumpfile,error,i,hdr,ftr,line,ts
set ts="_"_$tr($horolog,",","_")
set scriptfile=$select(isVMS:"dsedump"_ts_".com",1:"dsedump"_ts_".sh")
set dsecmd=$select(isVMS:"@",1:"chmod 755 "_scriptfile_"; ./")_scriptfile
set dumpfile="dsedump.txt"
open scriptfile:newversion use scriptfile
; print the header
set hdr=$select(isVMS:"dsecomhdr",1:"dseshhdr")
for i=1:1 set line=$text(@hdr+i) quit:line["quit" write $piece(line,";",2),!
; print the dump commands per region
for curreg=2:1:$length(regionlist,",") do
. set region=$piece(regionlist,",",curreg)
. if $length(region)>0 write region,! ; should be 0 only when curreg=2
. write cmd,!
; print the footer
set ftr=$select(isVMS:"dsecomftr",1:"dseshftr")
for i=1:1 set line=$text(@ftr+i) quit:line["quit" write $piece(line,";",2),!
; close and execute the script file
close scriptfile
zsystem dsecmd
; read script output and rename the file
open dumpfile:readonly use dumpfile set error=$$parsefhead(.output)
close dumpfile:(rename=dumpfile_ts)
; if no error occurred and debug is UNDEF, delete the script file
if (0=error)&(0=$data(debug)) open scriptfile:readonly close scriptfile:delete
quit error
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; generate the applicable region list
; the output string is a comma separated list of "FIND -REGION=<REGNAME>" and
; not a list of regions. The first piece is always null as a null string
; indicates that the script could find no applicable regions. The second piece
; could be null. If so, that piece represents the first region in which DSE
; starts up
reglist(reglist,isVMS)
; reglist - comma separated list of regions
; isVMS - use '/' (vms) or '-' (unix) for the modifier
; determine GT.CM regions, '::' (vms) vs ':' (unix)
new reg,regavail,i,mod,gtcmKey,regpath
set mod=$select(isVMS:"/",1:"-")
set gtcmKey=$select(isVMS:"::",1:":")
; determine the applicable regions - reglist vs actual available regions
set reglist=$select($get(reglist)="":"*",reglist="ALL":"*",1:reglist)
set regavail=""
if "*"'=reglist for i=1:1:$length(reglist,",") do
. set reg=$piece(reglist,",",i) set regavail(reg)=1 ; define the region
kill reg
for i=1:1 set reg=$view("gvnext",$get(reg)) quit:reg="" do
. set regpath=$VIEW("GVFILE",reg)
. quit:(1<$length(regpath,gtcmKey))
. if ("*"=reglist)!($data(regavail(reg))) do
. . set $piece(regavail,",",$length(regavail,",")+1)=$select(i>1:"find "_mod_"region="_reg,1:"")
quit regavail
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
parsefhead(output,active)
new error,debug,fcnt,field,file,i,line,parsed,region,value
set error=0
if $data(%DSEWRAP("debug")) set debug=$increment(%DSEWRAP("debug"))
if $length($etrap)=0 set $etrap="use $p zshow ""*"" halt"
;
for i=1:1 read line(i):5 quit:error quit:$zeof quit:$select($data(active)=0:0,line(i)["DSE>":1,1:0) do
. if ($test=0)&($length(line(i))=0) write !
. set line=$tr($$FUNC^%TRIM(line(i)),$c(10,13),"")
. quit:($length(line)=0)
. if line["%GTM-E-" set error=1 if $data(%DSEWRAP("debug")) set debug(debug,"error")=line
. if line?1"DSE>".E kill region,file quit ; DSE prompt means reset header information
. quit:line["Error: already in region: " ; ignore already in region error
. if line?1"File"1." ".E set fcnt=$length(line," "),file=$piece(line," ",fcnt) quit
. if line?1"Region"1." ".E do quit
. . set fcnt=$length(line," "),region=$piece(line," ",fcnt)
. . if $data(parsed(region,"File")) kill parsed(region) ; DUPLICATE, throw it away
. . set parsed(region,"File")=file
. quit:$data(region)=0
. if line?1"Date/Time".E set parsed(region,"Date/Time")=$$FUNC^%TRIM($extract(line,10,$length(line))) quit
. ;;; Match stats like output "DRD : #"
. else if line?3(1U,1N)1" : #".E do
. . set field=$$FUNC^%TRIM($piece(line,"0x",1)),value="0x"_$piece(line,"0x",2)
. . do addfield(.parsed,region,field,value)
. ;;; Match lines with " : (0x[0-9A0Z]*| (TRUE|FALSE))" in them
. else if $length(line," : ")>1 do
. . set field=$$FUNC^%TRIM($piece(line," : ",1)),value=$tr($piece(line," : ",2)," ","")
. . do addfield(.parsed,region,field,value)
. ;;; Match all column oriented data
. else do
. . ;;;; Adjust for the varying column width - the order matters
. . if $extract(line,44,45)=" " set $extract(line,44,45)="|" ; dump -all : Snapshot information
. . else if $extract(line,35,42)=" " set $extract(line,35,42)="|" ; dump -all : all after "Full Block Write.*"
. . else if $extract(line,42,43)=" " set $extract(line,42,43)="|" ; dump
. . new columns,col,data,lastfield,lastpiece
. . set columns=$length(line,"|")
. . ;;;; Handle the column data
. . for col=1:1:columns do
. . . set data=$$FUNC^%TRIM($piece(line,"|",col)) ; trim because of "Snapshot in progress"
. . . set lastpiece=$length(data," ")
. . . ;;;;;; Special case - value is a compound statement like "[WAS_ON] OFF"
. . . if (data["State")&(data["[") set lastpiece=$length(data," ")-1
. . . ; value is separated by the last space
. . . set value=$piece(data," ",lastpiece,$length(data," "))
. . . ; take everything but the value and trim off extra spaces
. . . set field=$$FUNC^%TRIM($extract(data,1,($length(data)-$length(value))))
. . . ;;;;;; Special case - fields where value may not exist
. . . if (data?1"Snapshot file name")!(data?1(1"Journal",1"Temp")1" File:") set value="",field=data
. . . ;;;;;; Special case - paired records like those with "Transaction ="
. . . if field="Transaction =" set field=lastfield_" TN" ; handle paired records
. . . if $data(%DSEWRAP("debug")) set debug(debug,i,field)=value
. . . do addfield(.parsed,region,field,value)
. . . set lastfield=field
merge output=parsed
if $data(%DSEWRAP("debug")) do
. merge %DSEWRAP("debug",debug,"line")=line
. set debug(debug,"pipe0ZOEF")=$zeof,debug(debug,"pipe0DEVICE")=$device,debug(debug,"pipe0ZA")=$ZA
. merge %DSEWRAP("debug")=debug
quit:$quit error quit
addfield(var,region,field,value)
if $data(var(region,field))\10 set var(region,field,$increment(var(region,field)))=value
else if $data(var(region,field)) do
. set var(region,field,1)=var(region,field),var(region,field)=2,var(region,field,2)=value
else set var(region,field)=value
quit
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
errtrap
use $p
set $etrap="use $principal write $zstatus,! zhalt 1"
set userecode=$piece($ecode,",",2)
set errtext=$select(userecode?1"U"3N:$text(@userecode),1:"")
if $length(errtext) write $text(+0),@$piece(errtext,";",2),!
else write $zstatus,!
if $zlevel<5 zhalt +$extract(userecode,2,$length(userecode))
quit
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Scripts to drive DSE via ZSystem
dsecomhdr
;$ define sys$output dsedump.txt
;$ define sys$error dsedump.txt
;$ purge /nolog dsedump.txt
;$ $gtm$dist:dse.exe
quit
dsecomftr
;$ deassign sys$output
;$ deassign sys$error
quit
dseshhdr
;#!/bin/sh
;$gtm_dist/dse > dsedump.txt 2>&1 << EOF
quit
dseshftr
;EOF
quit
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Error message texts
U251 ;"-F-NOREGIONS none of the target regions exist"
U252 ;"-F-NOPIPENOALTERNATE GT.M "_$zversion_" does not support pipes and cannot drive a different version of GT.M"
U253 ;"-F-ILLEGALDETAIL """_detail_""" is not a valid specification of details to dump"
U254 ;"-F-ILLEGALSELECTION """_what_""" is not a valid selection of what to dump"
U255 ;"-F-BADINVOCATION Must invoke as DO DUMP^"_$text(+0)_"(...)"
|