[groff] 01/01: 'gropdf' does not correctly load new ghostscript fonts

[Deri James]

deri pushed a commit to branch master
in repository groff.

commit fe51e3b63753f9c4b139b609329e211b1e7ca6e2
Author: Deri James <address@hidden>
Date:   Mon Aug 21 15:14:54 2017 +0100

    'gropdf' does not correctly load new ghostscript fonts
    
    See bug at: https://savannah.gnu.org/bugs/?50989. Since
    ghostscript 9.21 the fonts supplied have changed from .pfb to .pfa type
    (with a raw binary section). These failed to be properly loaded.
    
    * src/devices/gropdf/gropdf: Changes to handle raw binary section
    in a .pfa type font.
---
 ChangeLog                    |  11 +++
 src/devices/gropdf/gropdf.pl | 162 +++++++++++++++++++------------------------
 2 files changed, 81 insertions(+), 92 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 8bf97ce..c2f8369 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,14 @@
+2017-08-21  Deri James  <address@hidden>
+
+       'gropdf' does not correctly load new ghostscript fonts
+
+       See bug at: https://savannah.gnu.org/bugs/?50989. Since ghostscript
+       9.21 the fonts supplied have changed from .pfb to .pfa type (with a
+       raw binary section). These failed to be properly loaded.
+
+       * src/devices/gropdf/gropdf: Changes to handle raw binary section in
+       a .pfa type font.
+
 2017-08-18  Bertrand Garrigues <address@hidden>
 
        `pdfmom' man page incorrectly displayed.
diff --git a/src/devices/gropdf/gropdf.pl b/src/devices/gropdf/gropdf.pl
index 6fec8bd..de357c0 100644
--- a/src/devices/gropdf/gropdf.pl
+++ b/src/devices/gropdf/gropdf.pl
@@ -2,7 +2,7 @@
 #
 #      gropdf          : PDF post processor for groff
 #
-# Copyright (C) 2011-2015 Free Software Foundation, Inc.
+# Copyright (C) 2011-2017 Free Software Foundation, Inc.
 #      Written by Deri James <address@hidden>
 #
 # This file is part of groff.
@@ -2236,130 +2236,108 @@ sub GetType1
 
     OpenFile(\$f,$fontdir,"$file");
     Msg(1,"Failed to open '$file'") if !defined($f);
-    binmode($f);
 
-    my $l=<$f>;
+    $head=GetChunk($f,1,"currentfile eexec");
+    $body=GetChunk($f,2,"00000000") if !eof($f);
+    $tail=GetChunk($f,3,"cleartomark") if !eof($f);
 
-    if (substr($l,0,1) eq "\x80")
+    $l1=length($head);
+    $l2=length($body);
+    $l3=length($tail);
+
+    return($l1,$l2,$l3,"$head$body$tail");
+}
+
+sub GetChunk
+{
+    my $F=shift;
+    my $segno=shift;
+    my $ascterm=shift;
+    my ($type,$hdr,$chunk,@msg);
+    binmode($F);
+    my $enc="ascii";
+    
+    while (1)
     {
-       # PFB file
-       sysseek($f,0,0);
-       my $hdr='';
-       $l1=$l2=$l3=0;
-       my $typ=0;
-       my $data='';
-       my $sl=0;
+       # There may be multiple chunks of the same type
+       
+       my $ct=read($F,$hdr,2);
        
-       while ($typ != 3)
+       if ($ct==2)
+       {
+           if (substr($hdr,0,1) eq "\x80")
            {
-           my $chk=sysread($f,$hdr,6);
+               # binary chunk
                
-           if ($chk < 2)
+               my $chunktype=ord(substr($hdr,1,1));
+               $enc="binary";
+               
+               if (defined($type) and $type != $chunktype)
                {
-               # eof($f) uses buffered i/o (since file was open not sysopen)
-               # which screws up next sysread. So this will terminate loop if 
font
-               # has no terminating section type 3.
-               last if $l3;
-               return(5,$l2,$l3,undef);
+                   seek($F,-2,1);
+                   last;
                }
                
-           $typ=ord(substr($hdr,1,1));
+               $type=$chunktype;
+               return if $chunktype == 3;
                
-           if ($chk == 6)
-           {
-               $sl=unpack('L',substr($hdr,2,4));
-               $chk=sysread($f,$data,$sl);
-               return(1,$l2,$l3,undef) if $chk != $sl;
-           }
+               $ct=read($F,$hdr,4);
                
-           if ($typ == 1)
-           {
-               if ($l2 == 0)
-               {
-                   # First text bit(s) must be head
-                   $head.=$data;
-                   $l1+=$sl;
+               Msg(1,"Failed to read binary segment length"), return if $ct != 
4;
+               
+               my $sl=unpack('L',$hdr);
+               my $data;
+               my $chk=read($F,$data,$sl);
+               
+               Msg(1 ,"Failed to read binary segment"), return if $chk != $sl;
+               
+               $chunk.=$data;
            }
            else
            {
-                   # A text bit after the binary sections must be tail
-                   $tail.=$data;
-                   $l3+=$sl;
-               }
-           }
-           elsif ($typ == 2)
-           {
-               return(2,$l2,$l3,undef) if $l3; # Found a binary bit after the 
tail
-               $body.=$data;
-               $l2+=$sl;
-           }
-           elsif ($typ != 3)
-           {
-               # What segment type is this!
-               return(3,$l2,$l3,undef);
-           }
-       }
+               # ascii chunk
                
-       close($f);
-       return($l1,$l2,$l3,"$head$body$tail");
-    }
+               my $hex=0;
+               seek($F,-2,1);
+               my $ct=0;
                
-    my (@lines)=(<$f>);
-    unshift(@lines,$l);
+               while (1)
+               {
+                   my $lin=<$F>;
                    
-    close($f);
+                   last if !$lin;
                    
-    Msg(1,"Font file '$file' must be an Adobe type 1 font file") if 
$lines[0]!~m/\%\!PS.Adobe/i;
-    $head=$body=$tail='';
+                   $hex=1,$enc.=" hex" if $segno == 2 and !$ct and 
$lin=~m/^[A-F0-9a-f]{4,4}/;
                    
-    foreach my $line (@lines)
+                   if ($segno !=2 and $lin=~m/^(.*$ascterm\n?)(.*)/)
                    {
-       if (!defined($l1))
+                       $chunk.=$1;
+                       seek($F,-length($2)-1,1) if $2;
+                       last;
+                   }
+                   elsif ($segno == 2 and $lin=~m/^(.*?)($ascterm.*)/)
                    {
-           if (length($line) > 19 and $line=~s/^(currentfile eexec)//)
-           {
-               $head.=$1;
-               $l1=length($head);
-               redo;
+                       $chunk.=$1;
+                       seek($F,-length($2)-1,1) if $2;
+                       last;
                    }
                    
-           $head.=$line;
+                   chomp($lin), $lin=pack('H*',$lin) if $hex;
+                   $chunk.=$lin; $ct++;
+               }
                
-           if ($line=~m/eexec$/)
-           {
-               #                               chomp($head);
-               #                               $head.="\x0d";
-               $l1=length($head);
-           }
-       }
-       elsif (!defined($l2))
-       {
-           #$line=~s/(\0\0)0+$/&1/;
-           if ($line=~m/^0+$/)
-           {
-               $l2=length($body);
-               $tail=$line;
-           }
-           else
-           {
-               chomp($line);
-               $body.=pack('H*',$line);
+               last;
            }
        }
        else
        {
-           $tail.=$line;
+           push(@msg,"Failed to read 2 header bytes");
        }
     }
     
-    $l1=length($head);
-    $l2=length($body);
-    $l3=length($tail);
-
-    return($l1,$l2,$l3,"$head$body$tail");
+    return $chunk;
 }
 
-
 sub OutStream
 {
     my $ono=shift;