🚀 go-pugleaf

In article <82020@ut-emx.uucp> clyde@emx.cc.utexas.edu (Senior UNIX Wacker) writes:

> Does anyone have a good PostScript printer brain dumper?  I've got some
> 1/2-assed thing that dumps most of one dictionary at a time, but I'd really
> love a program that rummaged through everything in the interpeter and 
> printed it in a human-understanable form - following subdictionaries and
> such.

The following program lists the contents of a PostScript device.
It defines the procedure analyze which can investige a single postscript
object and call itself recursively on its contents.

Different fonts indicicate keys (bold) and operators (oblique).
Information like type, length, maxlength and protections are printed,
contents of strings etc etc.

After the definition of analyze is a list of calls to analyze that
goes through all dictionaries of a laserwriter that I know of.
The last call takes care of all other found dictionaries that it has found.

Every object is listed on a single line even though a 7 pt font is used,
the output is quite long. Over 60 pages I think on an apple laser writer.
!!!WARNING!!! did you read that? 60 pages! And it takes quite some time aswell.
I've never done it all at once.

It even looks for internaldict and prints out the execstack.
If analyze is used with "{analyze} superexec" it can list the contents
of secret objects, if also /ignorerprot is set to true.
Sometimes this fails anyway so I have commented out some superexec statements.

This mode is turned of for the listing of serverdict, because I get a
invalidaccess there if I list it all at once using superexec, but
the program can list the secret procedures in serverdict as well
if done one at a time.

Actually all that is needed to print out what's in all dictionaries
is to loop through the dict synonyms like what is done in the last call
to analyze in the program, but I take one dict at a time, because I want
different layout parameters for different dictionaries.

Distribution of this program is allowed as long as the header of it
including my name is not removed.

%!
% ANALYZE.PS version 10, (c) Fredric Ihren, fred@nada.kth.se, 20 June 1992
% (880604, 871030, 890424, 890602)
% This program comes without warranty and the author takes no responsibility
% for consequences of its use.
%
% Lists the structure of any postscript object. Calls itself recursively
% on the elements of dictionaries and arrays to any level.
% Usefull for analyzing internal dictionaries and definitions of system
% procedures written in postscript etc.
% Call format:   object analyze
%
% The list format will be determined from the value of the follwing constants:
% name              type     typical   desc.
%
% /startlevel       integer   0        level for the passed object
% /maxlevel         integer   5?       maximum level (program ignores deeper)
% /noprglist        boolean   false    true => skip contents of exec. array
% /nodictbelow      integer   0        program ignores contents of dicts with
%                                      level higher than this
% /dictlenmax       integer   50       list contents of dicts with size <= this
% /dictlenmaxelse   integer   2        list this many elements of dicts with
%   size > dictlenmax (and then write (--Aborted--) if dictlenmaxelse > 0)
% /arraylenmax      integer   50       same as dictlenmax but for arrays
% /arraylenmaxelse  integer   2        same as dictlenmaxelse but for arrays
% /title            string    (?)      name of object listed (header of page)
% /synonymlevelbelow  int 0        try to identify objects below this level
% /sort	    	    bool      true     sort the entries in the dicts ?
% /ignorerprot	    bool      false    ignore read protections (if superexec)

200 dict begin % so that an "undisturbed" userdict can be listed

clippath pathbbox newpath 24 sub /YH exch def 7 sub /XH exch def
  15 add /YL exch def 11 add /XL exch def /HY YH 18 sub def
  /TY YH 26 sub def /RY YH 33 sub def /YT YH 53 sub def /YB YL 6 add def

% /XL 24  def /XH 570 def /YL 24  def /YH 818 def
% /HY 800 def /TY 792 def /RY 785 def /YT 765 def /YB 30 def

/AS 50 def /BS AS 15 add def /CS 90 def /DS 300 def /ES 451 def
/FS 488 def /GS 505 def /HS 522 def /IS 539 def /JS IS 15 add def  % page offs
/maxn 9999 def                        % big number to break at
/maxstrlendic 33 def                  % maxlen of string in dictionary mode
/maxstrlenarr 84 def                  % maxlen of string in array mode
/PG 1 def
/$ 255 string def
/Nf /Courier findfont 7 scalefont def /CY 7 def % Normal font
/Kf /Courier-Bold findfont 7 scalefont def      % Dictionary key font
/Of /Courier-Oblique findfont 7 scalefont def	% Operator font
/Sf /Courier findfont 5 scalefont def           % Small font
/Tf /Times-Bold findfont 12 scalefont def       % Title font

/$1 128 string def  /$2 128 string def

/xmov { currentpoint exch pop moveto } def
/out { $ cvs show } def

/inipage {
  XL YL moveto XH YL lineto XH YH lineto XL YH lineto closepath
  XL TY moveto XH TY lineto stroke
  gsave
    0 RY moveto Sf setfont
    AS xmov (Lev) show BS xmov (Nr) show CS xmov (Object) show DS xmov (Value)
    show ES xmov (Type) show FS xmov (Mlen) show GS xmov (Len) show HS xmov
    (Prot) show IS xmov (Lev) show JS xmov (Nr) show
    AS HY moveto Tf setfont title show
    HS xmov PG out
  grestore
  0 YT moveto
} def

/cr {
  0 currentpoint exch pop CY sub dup YB lt
    { pop pop showpage /PG PG 1 add def inipage }
    { moveto }
  ifelse
} def

/sortdict {
  dup { length } stopped { pop 1000 } if array /sarray exch def
  /i 0 def
  { 2 array astore sarray i 3 -1 roll put /i i 1 add def } forall
  % { vals i 3 -1 roll put keys i 3 -1 roll put /i i 1 add def } forall
  /sdlen i def
  /step 1 sdlen ln 2 ln div cvi bitshift 1 sub def
  { 0 1 sdlen step sub 1 sub
    { /ix exch def /flg true def
      { flg ix 0 ge and not { exit } if
        sarray ix get
        sarray ix step add get dup
        0 get $1 cvs 2 index 0 get $2 cvs lt
          { sarray exch ix exch put
            sarray exch ix step add exch put
            /ix ix step sub def }
          { pop pop /flg false def }
        ifelse
      } loop
    } for
    step 2 idiv dup 0 eq { pop exit } if
    /step exch def
  } loop
} def

/typenumbers 20 dict dup begin
  /arraytype	    0 def
  /packedarraytype  1 def
  /stringtype	    2 def
  /dicttype         3 def
  /filetype	    4 def
  /integertype	    5 def
  /realtype	    6 def
  /booleantype	    7 def
  /operatortype	    8 def
  /nametype	    9 def
  /marktype	   10 def
  /nulltype	   11 def
  /savetype	   12 def
  /fonttype	   13 def
  /unknowntype	   14 def
end def

/scandictfordicts {
  dup type /dicttype eq {
    1 index /FontDirectory ne 1 index rcheck and {
      currentdict 1 index known not {
        dup /scandictfordicts load forall
      } if
    } if
    currentdict 2 index known not
      { exch $ cvs dup length string copy def }
      { pop pop }
    ifelse
  } { pop pop } ifelse
} def

/synonyms 150 dict dup begin
  /unknowndict (dictionary) def
  systemdict (systemdict) def
  systemdict /scandictfordicts load forall
  currentdict userdict known not {
    userdict (userdict) def
    userdict /scandictfordicts load forall
  } if
  mark /== load dup type /packedarraytype eq
  { dup rcheck { 0 get dup type /dicttype eq { (==dict) def } if } if } if
  cleartomark
end def

% synonyms { print (\n) print pop } forall
/getintervalsafe
  { { getinterval } stopped { pop pop pop protectedstring } if } def
/protectedstring (-- Read Protected --) def

/typeprocedures 15 dict dup begin
  /arraytype {
    /breakm len arraylenmax le { maxn } { arraylenmaxelse } ifelse def
    noprglist xprot not and { /breakm 0 def } if
    dictlist?
      { xprot { ([..]) } { ({..}) } ifelse show }
      { xprot { ([) } { ({) } ifelse show }
    ifelse cr /m -1 def
    ignorerprot { false } { rprot } ifelse
    level maxlevel ge or breakm 0 eq or
      { pop }
      {
        { /m m 1 add def
          m breakm ge { pop abort } if
          level exch n exch m exch dictlist? exch
          breakm exch xprot exch rprot exch
          /n m def
          /dictlist? false def
          analyzeinternal
          /rprot exch def /xprot exch def /breakm exch def
          /dictlist? exch def /m exch def /n exch def /level exch def
        } forall
      }
    ifelse
    dictlist? not {
      CS xmov indent xprot { (]) } { (}) } ifelse show
      ES xmov (endarray) show
      AS xmov level out BS xmov n out cr
    } if
  } def
  
  /packedarraytype /arraytype load def

  /stringtype {
    ignorerprot { false } { rprot } ifelse
    { pop protectedstring } if
    dictlist?
      { len maxstrlendic gt len maxstrlenarr 20 add le and { cr CS xmov true }
        { maxstrlendic dup len le { 0 exch getintervalsafe false } { pop true }
          ifelse } ifelse }
      { maxstrlenarr level startlevel sub 2 mul sub dup len le
        { 0 exch getintervalsafe false } { pop true } ifelse }
    ifelse (\() show exch show { (\)) show } if cr
  } def

  /dicttype {
    dup synonyms exch known
      { dup synonyms exch get }
      { synonyms /unknowndict get }
    ifelse show
    /breakm len dictlenmax le { maxn } { dictlenmaxelse } ifelse def
    cr /m -1 def
    ignorerprot { false } { rprot } ifelse
    level maxlevel ge or level nodictbelow gt or breakm 0 eq or
      { pop }
      {
        sort { sortdict sarray } if
        { sort { aload pop } if
          /m m 1 add def
          m breakm ge { pop pop abort } if
          exch dup type /nametype eq {
            dup /keyname exch def
            CS xmov indent gsave Kf setfont (  /) show out grestore
          }
          { /keyname (--nostringval--) def
            level exch n exch m exch dictlist? exch
            breakm exch xprot exch rprot exch
            /dictlist? false def
            /n m def
            gsave Kf setfont analyzeinternal currentpoint grestore moveto
            /rprot exch def /xprot exch def /breakm exch def
            /dictlist? exch def /m exch def /n exch def
            /level exch def
          } ifelse
	  level exch n exch m exch dictlist? exch
	  breakm exch xprot exch rprot exch
          /dictlist? true def
          /n m def
          analyzeinternal
          /rprot exch def /xprot exch def /breakm exch def
          /dictlist? exch def /m exch def /n exch def /level exch def
        } forall
      }
    ifelse
  } def

  /filetype { pop ("File") show cr } def
  /integertype { out cr } def
  /realtype /integertype load def
  /booleantype /integertype load def
  
  /operatortype { gsave Of setfont out grestore cr } def
  /nametype { xprot { (/) show } if out cr }  def
  /marktype { pop ("Mark") show cr } def
  /nulltype { pop ("Null") show cr } def
  /savetype { pop ("Save") show cr } def
  /fonttype { pop ("Font") show cr } def
  /unknowntype { pop ("????") show cr } def
end def % typeprocedures

/line {
  dup type cvlit dup /otype exch def /xtype exch def
  /tn typenumbers otype known
    { typenumbers otype get }
    { /xtype /unknowntype def typenumbers /unknowntype get }
  ifelse def
  /rprot false def /wprot false def
  dup xcheck not /xprot exch def
  tn 3 le { 
    dup rcheck not /rprot exch def
    dup wcheck not /wprot exch def
  } if
  AS xmov level out BS xmov n out IS xmov level out JS xmov n out
  ES xmov /otype load $ cvs dup length 0 exch 4 sub getinterval show
  tn 4 lt ignorerprot not { rprot not and } if {
    dup { length } stopped { pop /len 0 def /? } {dup /len exch def } ifelse
    GS xmov out
    tn 3 eq { dup { maxlength } stopped { pop /? } if
      FS xmov out
    } if
  } { /len 0 def } ifelse
  HS xmov
  xprot {(X)} {(-)} ifelse show
  wprot {(W)} {(-)} ifelse show
  rprot {(R)} {(-)} ifelse show
} def

/indent { level startlevel sub { (  ) show } repeat } def
/abort {
  CS xmov indent (  -- Aborted --) show
  AS xmov level 1 add out BS xmov m out cr exit
} def

/analyzeinternal {
  /level level 1 add def
  line
  dictlist? { DS xmov } { CS xmov indent } ifelse
  synonyms 1 index { known } stopped { pop pop false } if
  xtype /dicttype ne and level synonymlevelbelow gt and
    { synonyms exch get show cr }
    { typeprocedures xtype get exec }
  ifelse
} def

/analyze {
%   (Analyze.) print flush
   gsave % save exch
     /level startlevel 1 sub def
     /dictlist? false def
     /n 0 def
     initmatrix Nf setfont inipage
     analyzeinternal
%   restore grestore
   grestore
   showpage
%   ($$\n) print
} def

% defaults
/startlevel 0 def
/maxlevel 20 def
/noprglist false def
/nodictbelow 0 def
/dictlenmax 600 def
/dictlenmaxelse 2 def
/arraylenmax 600 def
/arraylenmaxelse 0 def
/synonymlevelbelow 0 def
/sort true def
/ignorerprot false def
/title () def

% ------- the rest of the program lists the contents of all known dictionaries
/dictionaries synonyms dup length dict copy def
/title (Dictionaries) def
% dictionaries analyze

/mget { 2 copy known { get true } { false } ifelse } def

% if superexec: use it
{ 1183615869 internaldict /idict exch def
%  idict /superexec mget
%  { /analyze { 0 exec } dup 0 /analyze load put dup 1 idict /superexec get put
%    def
%    /ignorerprot true def
%  } if
  /superexec idict /superexec get def
} stopped pop clear

/arraylenmax 10 def
/title (systemdict:) def
/noprglist true def
systemdict analyze

/noprglist false def
/arraylenmax 600 def
/arraylenmaxelse 0 def
systemdict analyze

/noprglist true def
/arraylenmax 0 def
/title (statusdict:) def
/statusdict where { /statusdict get analyze } if

/noprglist false def
/arraylenmax 200 def
/statusdict where { /statusdict get analyze } if

/$printerdict where {
  /arraylenmax 6 def
  /title ($printerdict) def
  $printerdict analyze

  /arraylenmax 200 def
  /noprglist false def
  synonyms $printerdict /setpage mget { ($printerdict:setpage) put } if
  synonyms $printerdict /dopage mget { ($printerdict:dopage) put } if
  /synonymlevelbelow 1 def
  $printerdict analyze
  /synonymlevelbelow 0 def
} if

/noprglist true def
/arraylenmax 0 def
/title (userdict:) def
userdict analyze

/noprglist false def
/arraylenmax 200 def
userdict analyze

/title (execdict:) def
/execdict where { /execdict get analyze } if

synonyms systemdict /.error mget { (systemdict:.error) put } if
/title (errordict:) def
/errordict where { /errordict get analyze } if

/noprglist true def
/arraylenmax 0 def
/title ($error) def
/$error where { /$error get analyze } if

% /nodictbelow 1 def
/noprglist true def
/arraylenmax 0 def
/title (serverdict:) def
/serverdict where { /serverdict get analyze } if

/noprglist false def
/arraylenmax 300 def
/ignore ignorerprot def
/serverdict where { serverdict analyze } if
/ignorerprot ignore def
/nodictbelow 0 def

/title ($idleTimeDict) def
synonyms serverdict /watchstreams mget { (serverdict:watchstreams) put } if
/$idleTimeDict where { /$idleTimeDict get analyze } if

/title (==dict:) def
/== load dup type /packedarraytype ne { pop }
 { 0 get dup type /dicttype eq { analyze } if } ifelse

currentdict /idict known { 
  /title (internaldict:) def
  /noprglist false def
  /nodictbelow 1 def
  idict analyze % 10 pages on LW II NTX
} if

/nodictbelow 20 def
/arraylenmaxelse 2 def
/dictlenmax 35 def
/dictlenmaxelse 2 def
/title (FontDirectory) def
synonyms systemdict /StandardEncoding get (systemdict:StandardEncoding)
  put
currentdict /idict known {
  synonyms idict /CharMap mget { (internaldict:CharMap) put } if } if
/sort false def
/FontDirectory where { /FontDirectory get analyze } if
/sort true def

/nodictbelow 0 def
/arraylenmaxelse 0 def
/title (execstack) def
countexecstack array execstack analyze

serverdict begin statusdict begin /startpage where end end {
  /title (startpage) def
  /arraylenmax 600 def
  1000 array /i 0 def
  exch /startpage get
  { token
      { 2 index exch i exch put /i i 1 add def }
      { exit }
    ifelse
  } loop
  0 i getinterval analyze
} if

/title (FontDirectory:Helvetica) def
/nodictbelow 7 def
/noprglist false def
/ignorerprot true def
/sort false def
/Helvetica findfont analyze
/sort true def

clear
/plup { dup where { exch get } { pop systemdict } ifelse } def

% analyze all other found dictionaries:
/nodictbelow 0 def
/dictlenmax 600 def
/dictlenmaxelse 2 def
/arraylenmax 256 def
/arraylenmaxelse 0 def
/noprglist false def
dictionaries { 
  /title exch def
  /poem exch def
  /statusdict plup begin /serverdict plup begin
  poem type /dicttype eq
  poem systemdict ne and poem userdict ne and poem /statusdict plup ne and
  poem /serverdict plup ne and poem /$idleTimeDict plup ne and
  poem /$error plup ne and poem /errordict plup ne and poem /$error plup ne and
  poem /$printerdict plup ne and poem /FontDirectory plup ne and
  poem /execdict plup ne and title (==dict:) ne and
  end end
  { poem analyze } if
} forall