#    debsigs: Package signing/verification system, arf module
#    AR File manipulation libraries
#    Copyright (C) 2000   Progeny Linux Systems, Inc. <jgoerzen@progeny.com>
#    Copyright (C) 2009   Peter Pentchev <roam@ringlet.net>
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

package Debian::debsigs::arf;

use strict;
use warnings;

use Cwd;
use Fcntl qw/SEEK_CUR/;
use IO::Pipe;
use IO::Handle;

use Debian::debsigs::forktools ':all';

#my $CVSVERSION = '$Progeny: arf.pm,v 1.11 2001/05/09 11:21:52 epg Exp $'; #'
#my ($VERSION) = $CVSVERSION =~ /^\$Progeny: .+,v ([0-9.]+) /;
our $VERSION = '1.12';

my $ARMAG = "!<arch>\n";
my $SARMAG = length $ARMAG;

sub new {
  my ($class, $filename) = @_;
  my $self = {};

  $self->{filename} = ($filename =~ m'^/') ? $filename : 
    getcwd() . "/$filename";
  $self->{ar} = '/usr/bin/ar';
  bless $self, $class;
  return $self;
}

sub getfiles {
  my ($self, @filenames) = @_;
  
  return forkreader(undef, $self->{ar}, "-p", $self->{filename},
			       @filenames);
}


# If a data fd is specified, assume that someone already has an fd
# that would like to use for piping in data.  Otherwise, generate
# a new one to let them print to.

sub setfile {
  my ($self, $filename) = @_;

  return(system($self->{ar}, "-r", 
		$self->{filename}, $filename));
}

# Delete the specified file.

sub delete {
  my ($self, $filename) = @_;

  return(system($self->{ar}, "-d",
		$self->{filename}, $filename));
}

#

sub contents {
  my ($self) = @_;
  my ($fd, $arpid) = 
    forkreader(undef, $self->{ar}, "-t", $self->{filename});
  
  my $line;
  my @retval;
  while (defined($line = <$fd>)) {
    chomp $line;
    push @retval, $line;
  }
  assertsuccess($arpid, 'ar -t');
  return @retval;
}

sub fixup {
  my ($self) = @_;
  my ($fd, $buf, $len);

  open($fd, '+<', $self->{'filename'}) or
    die("Opening $self->{filename} for trailing slash fixup: $!\n");

  $len = read($fd, $buf, $SARMAG);
  if (!defined($len)) {
    die("Reading the ar signature from $self->{filename}: $!\n");
  }
  if ($len != $SARMAG || $buf ne $ARMAG) {
    die("Invalid ar signature at the start of $self->{filename}\n");
  }

  while (defined($len = read($fd, $buf, 60)) && $len == 60) {
    my @fields = unpack("A16A12A6A6A8A10", $buf);

    # Strip a slash, with loads and loads of precautions
    if ($fields[0] =~ m{/$}) {
      seek($fd, -(60 - length($fields[0]) + 1), SEEK_CUR) or
	die("Seeking back to the slash for $fields[0] of $self->{filename}: $!\n");
      $len = read($fd, $buf, 1);
      if (!defined($len) || $len != 1 || $buf ne '/') {
	die("Could not seek back to the trailing slash for $fields[0] of $self->{filename}: $!\n");
      }
      seek($fd, -1, SEEK_CUR) or
	die("REALLY Seeking back to the slash for $fields[0] of $self->{filename}: $!\n");
      print $fd ' ' or
	die("Overwriting the trailing slash for $fields[0] of $self->{filename}: $!\n");
      seek($fd, 60 - length($fields[0]), SEEK_CUR) or
	die("Seeking to the end of the header for $fields[0] of $self->{filename}: $!\n");
    }

    # Skip the actual ar data
    seek($fd, $fields[5] + ($fields[5] % 2), SEEK_CUR) or
      die("Skipping $fields[5] for $fields[0] of $self->{filename}: $!\n");
  }

  if (!defined($len)) {
    die("Could not read the whole archive $self->{filename}: $!\n");
  }
  close($fd);
  return 1;
}

#  if ($datafd) {
#    return forktools::forkreader($datafd, $self->{ar}, "-r", $self->{filename},
#				 $filename);
#  } else {
#    return forktools::forkwriter(undef, $self->{ar}, "-r", $self->{filename},
#				 $filename);
#  }
#}

1;