1#! /usr/bin/perl 2 3use strict; 4# runs groff in safe mode, that seems to be the default 5# installation now. That means that I have to fix all nice 6# features outside groff. Sigh. 7# I do agree however that the previous way opened a whole bunch 8# of security holes. 9 10my $no_exec; 11# check for -x and remove it 12if (grep(/^-x$/, @ARGV)) { 13 $no_exec++; 14 @ARGV = grep(!/^-x$/, @ARGV); 15} 16 17# mmroff should always have -mm, but not twice 18@ARGV = grep(!/^-mm$/, @ARGV); 19my $check_macro = "groff -rRef=1 -z -mm @ARGV"; 20my $run_macro = "groff -mm @ARGV"; 21 22my (%cur, $rfilename, $max_height, $imacro, $max_width, @out, @indi); 23open(MACRO, "$check_macro 2>&1 |") || die "run $check_macro:$!"; 24while(<MACRO>) { 25 if (m#^\.\\" Rfilename: (\S+)#) { 26 # remove all directories just to be more secure 27 ($rfilename = $1) =~ s#.*/##; 28 next; 29 } 30 if (m#^\.\\" Imacro: (\S+)#) { 31 # remove all directories just to be more secure 32 ($imacro = $1) =~ s#.*/##; 33 next; 34 } 35 if (m#^\.\\" Index: (\S+)#) { 36 # remove all directories just to be more secure 37 my $f; 38 ($f = $1) =~ s#.*/##; 39 &print_index($f, \@indi, $imacro); 40 @indi = (); 41 $imacro = ''; 42 next; 43 } 44 my $x; 45 if (($x) = m#^\.\\" IND (.+)#) { 46 $x =~ s#\\##g; 47 my @x = split(/\t/, $x); 48 grep(s/\s+$//, @x); 49 push(@indi, join("\t", @x)); 50 next; 51 } 52 if (m#^\.\\" PIC id (\d+)#) { 53 %cur = ('id', $1); 54 next; 55 } 56 if (m#^\.\\" PIC file (\S+)#) { 57 &psbb($1); 58 &ps_calc($1); 59 next; 60 } 61 if (m#^\.\\" PIC (\w+)\s+(\S+)#) { 62 eval "\$cur{'$1'} = '$2'"; 63 next; 64 } 65 s#\\ \\ $##; 66 push(@out, $_); 67} 68close(MACRO); 69 70 71if ($rfilename) { 72 push(@out, ".nr pict*max-height $max_height\n") if defined $max_height; 73 push(@out, ".nr pict*max-width $max_width\n") if defined $max_width; 74 75 open(OUT, ">$rfilename") || "create $rfilename:$!"; 76 print OUT '.\" references', "\n"; 77 my $i; 78 for $i (@out) { 79 print OUT $i; 80 } 81 close(OUT); 82} 83 84exit 0 if $no_exec; 85exit system($run_macro); 86 87sub print_index { 88 my ($f, $ind, $macro) = @_; 89 90 open(OUT, ">$f") || "create $f:$!"; 91 my $i; 92 for $i (sort @$ind) { 93 if ($macro) { 94 $i = '.'.$macro.' "'.join('" "', split(/\t/, $i)).'"'; 95 } 96 print OUT "$i\n"; 97 } 98 close(OUT); 99} 100 101sub ps_calc { 102 my ($f) = @_; 103 104 my $w = abs($cur{'llx'}-$cur{'urx'}); 105 my $h = abs($cur{'lly'}-$cur{'ury'}); 106 $max_width = $w if $w > $max_width; 107 $max_height = $h if $h > $max_height; 108 109 my $id = $cur{'id'}; 110 push(@out, ".ds pict*file!$id $f\n"); 111 push(@out, ".ds pict*id!$f $id\n"); 112 push(@out, ".nr pict*llx!$id $cur{'llx'}\n"); 113 push(@out, ".nr pict*lly!$id $cur{'lly'}\n"); 114 push(@out, ".nr pict*urx!$id $cur{'urx'}\n"); 115 push(@out, ".nr pict*ury!$id $cur{'ury'}\n"); 116 push(@out, ".nr pict*w!$id $w\n"); 117 push(@out, ".nr pict*h!$id $h\n"); 118} 119 120 121sub psbb { 122 my ($f) = @_; 123 124 unless (open(IN, $f)) { 125 print STDERR "Warning: Postscript file $f:$!"; 126 next; 127 } 128 while(<IN>) { 129 if (/^%%BoundingBox:\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)/) { 130 $cur{'llx'} = $1; 131 $cur{'lly'} = $2; 132 $cur{'urx'} = $3; 133 $cur{'ury'} = $4; 134 } 135 } 136 close(IN); 137} 138