This one time, at band camp, Stephen Gran said: > Simple minded patch below. > > --- /usr/share/perl5/Archive/Ar.pm 2009-04-10 19:57:39.000000000 +0100 > +++ Ar.pm 2009-04-10 19:58:05.000000000 +0100 > @@ -173,7 +173,7 @@ > "date" => $mtime, > "uid" => $uid, > "gid" => $gid, > - "mode" => $mode, > + "mode" => sprintf("%o",$mode), > "size" => $size, > };
As it turns out, simple wasn't correct. We need to cast it going in and out in all code paths. Better patch below: --- /usr/share/perl5/Archive/Ar.pm 2009-04-10 19:57:39.000000000 +0100 +++ lib/Archive/Ar.pm 2009-04-11 14:49:19.000000000 +0100 @@ -219,7 +219,7 @@ $params->{uid} ||= 0; $params->{gid} ||= 0; $params->{date} ||= timelocal(localtime()); - $params->{mode} ||= "100644"; + $params->{mode} ||= "33188"; unless($this->_addFile($params)) { @@ -252,7 +252,13 @@ $content->{uid} ||= ""; $content->{gid} ||= ""; - $outstr.= pack("A16A12A6A6A8A10", @$content{qw/name date uid gid mode size/}); + $outstr.= pack("A16A12A6A6A8A10", ( + $content->{name}, + $content->{date}, + $content->{uid}, + $content->{gid}, + sprintf ("%o", $content->{mode}), + $content->{size})); $outstr.= ARFMAG; $outstr.= $content->{data}; unless (((length($content->{data})) % 2) == 0) { @@ -333,6 +339,7 @@ $fields[$_] =~ s/\s*$//g; } + $fields[4] = oct($fields[4]); my $headers = {}; @$headers{qw/name date uid gid mode size/} = @fields; -- ----------------------------------------------------------------- | ,''`. Stephen Gran | | : :' : sg...@debian.org | | `. `' Debian user, admin, and developer | | `- http://www.debian.org | -----------------------------------------------------------------
signature.asc
Description: Digital signature