#!/usr/bin/perl

#
# emulate the famous debian apt tools
# 
# 02.11.2003 by Thomas Koch <tom at linvdr.org>
#
use strict;
use URI;
use POSIX qw(strftime);
use Net::HTTP;
use Cwd;
use File::Basename;

$|=1;

my $ETCDIR = "/etc/apt";
#my $HOST = "http://debian.teleglobe.net";
my $HOST = "http://archive.debian.org/debian-archive";
my $PACKAGE_URL = "$HOST/dists/woody/main/binary-i386/Packages.gz";
my $PACKAGE_LIST = "$ETCDIR/Packages";
my $BASEDIR = getcwd();
my $TMP = "/tmp/dpkg";
my $ARCHIVES = "/var/cache/apt/archives";
my $PACKAGE_CONTENT = "/var/cache/apt/packages";
my @IGNORE = ("/usr/share/man", "/usr/share/doc");
my $verbose = 0;
my $xing = 0;
my $overwrite = 0;
my $testmode = 0;

mkdir($TMP); #XXX
system("mkdir -p $ARCHIVES");

my $myself = join("", $0 =~ /^.*\/(.*)/);
for(my $count = 0; $count < scalar(@ARGV); $count++) {
  $_ = $ARGV[$count];
  if(/-h|--help/) {
    printf("Usage %s [OPTION]...\n\n", join("", $0 =~ /^.*\/(.*)/));
    print("  -i <package>   download and install package\n");
    print("  -x             don't download anything, just print url\n");
    print("  -s             search\n");
    print("  -f <file.deb>  install \"file.deb\" file from harddisk/cdrom\n");
    print("  -o             overwrite existing files\n");
    print("  -u             update package list\n");
    print("  -v             verbose\n");
    print("  --test         testmode, will not install the package (useful with -v)\n");
    print("  -h             you are reading this\n\n");
    print("Report bugs to <linvdr\@linvdr.org>\n");
  }
  if(/^-x/) {
    $xing = 1;
  }
  if(/^-o/) {
    $overwrite = 1;
  }
  if(/^-v|^--verbose/) {
    $verbose = 1;
  }
  if(/^--test/) {
    $testmode = 1;
  }
  if(/^-u|^--update/) {
    if($xing) {
      print "$PACKAGE_URL\n";
    } else {
      GetPackageList($PACKAGE_URL);
    }
  }
  if(/^-i|^--install/) {
    my @packages;
    for(my $i = ($count + 1); $i < scalar(@ARGV); $i++) {
      my $value = $ARGV[$i]; 
      if(!$value) {
        print "install what?";
        exit(1);
      }
      my $url = Search(1, $value);
      if($url) {
        push(@packages, $url);
      } else {
        print "Can't find package: $value\n";
      }
    }
    if($xing) {
      for(@packages) {
        print "$_\n";
      }
    } else {
      for(@packages) {
        GetPackage($_);
        printf("Install %s...", basename($_));
        InstallDEB("$ARCHIVES/" . basename($_));
        print "done.\n";
      }
    }
  }
  if(/^-s|^--search/) {
    my $value = $ARGV[$count+1];
    if(!scalar($value)) {
      print "search what!?\n";
      exit(1);
    }
    for my $result (Search(0, $value)) {
      print "$result\n";
    }
    exit(0);
  } 
  if(/^-f|^--file/) {
    my $value = $ARGV[$count+1];
    InstallDEB($value);
  }
}

#############################################################################
#
#
sub human_size {
  my $size = shift;
  my @sign = ("b", "k", "M", "G", "T");
  my $sign = 0;
  while($size > 1024) {
    $size /= 1024;
    $sign++;
  }
  return(sprintf("%.2f%s", $size, $sign[$sign]));
}

sub Status {
  my $msg = join("", @_);
  print "\033[2K\033[0G$msg";
}

sub GetUrl {
  my $url = shift;
  my $uri = URI->new($url);
  my $s = Net::HTTP->new(Host => $uri->host) || die "connection to " . $uri->host . " failed";
  $s->write_request(GET => $uri->path);
  my($code, $mess, %h) = $s->read_response_headers;
  
  return(0) if($code ne "200");
  return($s, $h{"Content-Length"});
}

sub GetPackage {
  my $url = shift;
  my $file = basename($url);
  my $archive = "$ARCHIVES/$file";
  if(! -s $archive) { 
    printf("Download %s...\n", basename($url)); 
    my($s, $content_length) = GetUrl($url);
    open(FILE, ">$archive") || die "cant open $TMP/$file";
     
    my $received = 0;
    while(1) {
      my $buf;
      Status(
        sprintf("[%s/%s]", 
          human_size($received), 
          human_size($content_length)
        )
      );
      my $n = $s->read_entity_body($buf, 1024);
      print FILE $buf;
      last if(!$n);
      $received += $n;
    }
    close(FILE);
    print "\n";
  }
}

sub GetPackageList {
  my $url = shift;
  my($s, $content_length, $file) = GetUrl($url);  
  open(PIPE, "| gzip -d > $PACKAGE_LIST") || die "cant open pipe to gzip";
   
  my $received = 0;
  while(1) {
    my $buf;
    Status(
      sprintf("%s [%s/%s]", 
        $file, 
        human_size($received), 
        human_size($content_length)
      )
    );
    my $n = $s->read_entity_body($buf, 1024);
    print PIPE $buf;
    last if(!$n);
    $received += $n;
  }
  close(PIPE);
  print "\n";
}

sub Search {
  my $url = shift;
  my @results;

  open(FILE, $PACKAGE_LIST) || die "cant find $PACKAGE_LIST! dont forget to run \"debtool -u\"";
  while(<FILE>) {
    my %package;
    if(/^Package: /) {
      my($key, $value) = split(": ", $_, 2);
      chomp($value);
      $package{$key} = $value;
      while(<FILE>) {
        if(/^\n/) {
          last;
        } else {
          chomp;
          my($key, $value) = split(": ", $_, 2);
          $package{$key} = $value;
        }
      }
      for my $pattern (@_) {
        if($url) {
          if($package{"Package"} eq $pattern) {
            return "$HOST/debian/" . $package{"Filename"};
          }
        } else {
          if($package{"Package"} =~ /$pattern/ || $package{"Description"} =~ /$pattern/) {
	          push(@results, $package{"Package"} . " - " . $package{"Description"});
          }
        }
      }
    }
  }
  close(FILE);
  return(@results);
} 

sub InstallDEB {
  my $file = shift;

  if($file !~ /^\//) {
    $file = "$BASEDIR/$file";
  }
  
  execute("rm -fr $TMP");
  mkdir($TMP);
  chdir($TMP);
  
  execute("ar -x $file");
  mkdir("$TMP/data");
  execute("tar xzf data.tar.gz -C $TMP/data");
  mkdir("$TMP/control");
  execute("tar xzf control.tar.gz -C $TMP/control");
  chdir("$TMP/data");
  
  my @content;

  open(PIPE, "find . |");
  while(<PIPE>) {
    chomp;
    next if($_ eq ".");
    my $dest = join("", $_ =~ /^\.(.*)/);
    push(@content, $dest);
    my $found = 0;
    for my $ignore (@IGNORE) {
      if($dest =~ /^$ignore/) {
        print "Notice: $dest ignored\n" if($verbose);
        $found = 1;
        last;
      }
    } 
    next if($found);
    if(-e $dest && $overwrite == 0) {
      print "Warning: not overwriting $dest\n" if($verbose);
      next;
    }    
    if(-d $_) {
      system("mkdir -p $dest") if($testmode == 0);
      next;
    }
    print "$dest\n" if($verbose);
    execute("cp -a \"$_\" \"$dest\"") if($testmode == 0);
  }
  my $postinst = "$TMP/control/postinst-linvdr";
  if(-x $postinst) {
    system($postinst) if($testmode == 0);
  }
  execute("rm -fr $TMP");
  WritePackageList(basename($file), @content);
}

sub WritePackageList {
  my $package = shift;
  open(FILE, ">$PACKAGE_CONTENT/$package") || die "$!";
  for(@_) {
    print FILE "$_\n";
  }
  close(FILE);
}

sub execute {
  my $cmd = join("", @_);
  system($cmd);
}

__END__
