#!/usr/bin/perl -w

#
# Copyright (c) 2005 Michael Schroeder (mls@suse.de)
#
# This program is licensed under the BSD license, read LICENSE.BSD
# for further information
#

use Socket;
use Fcntl qw(:DEFAULT :flock);
use POSIX;
use Digest::MD5 ();
use Net::Domain ();
use bytes;
my $have_zlib;
eval {
  require Compress::Zlib;
  $have_zlib = 1;
};
use strict;

#######################################################################
# Common code user for Client and Server
#######################################################################

my $makedeltarpm = 'makedeltarpm';
my $combinedeltarpm = 'combinedeltarpm';
my $applydeltarpm = 'applydeltarpm';

sub rpminfo_f {
  local (*F) = shift;
  my $rpm = shift;

  my $lead;
  if (read(F, $lead, 96) != 96) {
    warn("$rpm: not a rpm\n");
    return ();
  }
  my ($magic, $sigtype) = unpack('N@78n', $lead);
  if ($magic != 0xedabeedb || $sigtype != 5) {
    warn("$rpm: not a rpm (bad magic or header type)\n");
    return ();
  }

  # 1) get md5 sum from signature header

  my $head;
  if (read(F, $head, 16) != 16) {
    warn("$rpm: not a rpm (no sig header intro)\n");
    return ();
  }
  my ($headmagic, $cnt, $cntdata) = unpack('N@8NN', $head);
  if ($headmagic != 0x8eade801) {
    warn("$rpm: not a rpm (bad sig header magic)\n");
    return ();
  }
  my $index;
  if (read(F, $index, $cnt * 16) != $cnt * 16) {
    warn("$rpm: not a rpm (sig header index read error)\n");
    return ();
  }
  $cntdata = ($cntdata + 7) & ~7;
  my $data;
  if (read(F, $data, $cntdata) != $cntdata) {
    warn("$rpm: not a rpm (sig header data read error)\n");
    return ();
  }

  my $sigmd5 = Digest::MD5::md5_hex("$lead$head$index$data");
  my $rpmmd5;
  my ($tag, $type, $offset, $count);
  while ($cnt-- > 0) {
    ($tag, $type, $offset, $count, $index) = unpack('N4a*', $index);
    next if $tag != 1004 || $type != 7 || $count != 16 || $offset + 16 > $cntdata;
    $rpmmd5 = sprintf("%08x%08x%08x%08x", unpack('N4', substr($data, $offset, 16)));
    last;
  }
  if (!$rpmmd5) {
    warn("$rpm: no md5 signature header\n");
    return ();
  }

  # 2) get buildtime/name/arch from header
  if (read(F, $head, 16) != 16) {
    warn("$rpm: not a rpm (no header intro)\n");
    return ();
  }
  ($headmagic, $cnt, $cntdata) = unpack('N@8NN', $head);
  if ($headmagic != 0x8eade801) {
    warn("$rpm: not a rpm (bad header magic)\n");
    return ();
  }
  if (read(F, $index, $cnt * 16) != $cnt * 16) {
    warn("$rpm: not a rpm (sig header index read error)\n");
    return ();
  }
  my $curpos = tell(F);
  my $name;
  my $arch;
  my $issrc = 1;
  my $srctype = 'src';
  my $buildtime;
  while ($cnt-- > 0) {
    ($tag, $type, $offset, $count, $index) = unpack('N4a*', $index);
    if (($tag == 1000 || $tag == 1022) && $type == 6) {
      if (!seek(F, $curpos + $offset, 0)) {
	warn("$rpm: not a rpm (seek to name/arch position)\n");
	return ();
      }
      my $var = '';
      while (!($var =~ s/\0.*//s)) {
	my $l = $cntdata - $offset - length($var);
	if ($l < 1 || read(F, $var, $l > 16 ? 16 : $l, length($var)) < 1) {
	    warn("$rpm: not a rpm (name/arch read)\n");
	    return ();
	}
      }
      next unless defined $var && $var ne '';
      $name = $var if $tag == 1000;
      $arch = $var if $tag == 1022;
      next;
    }
    if ($tag == 1044) {
      undef $issrc;
      next;
    }
    if ($tag == 1051 || $tag == 1052) {
      $srctype = 'nosrc';
      next;
    }
    next if $tag != 1006 || $type != 4 || $count < 1 || $offset + 4 > $cntdata;
    if (!seek(F, $curpos + $offset, 0)) {
      warn("$rpm: not a rpm (seek to buildtime position)\n");
      return ();
    }
    if (read(F, $data, 4) != 4) {
      warn("$rpm: not a rpm (buildtime read)\n");
      return ();
    }
    $buildtime = unpack('N', $data);
  }
  if (!defined($buildtime)) {
    warn("$rpm: no buildtime in header\n");
    return ();
  }
  $arch = $srctype if $issrc;
  $name = 'unknown' if $name =~ /[\/ ]/;
  $arch = 'unknown' if $arch =~ /[\/ ]/;
  $name ||= 'unknown';
  $arch ||= 'unknown';
  $buildtime = sprintf("%08x", $buildtime);
  return("$sigmd5$rpmmd5", $buildtime, "$name.$arch");
}

sub rpminfo {
  my $rpm = shift;
  local *RPM;
  if (!open(RPM, "<$rpm")) {
    warn("$rpm: $!\n");
    return ();
  }
  my @ret = rpminfo_f(*RPM, $rpm);
  close RPM;
  return @ret;
}

sub fileinfo_f {
  local (*F) = shift;

  my $ctx = Digest::MD5->new;
  $ctx->addfile(*F);
  return $ctx->hexdigest;
}

sub fileinfo {
  my $fn = shift;
  local *FN;
  if (!open(FN, "<$fn")) {
    warn("$fn: $!\n");
    return ();
  }
  my @ret = fileinfo_f(*FN, $fn);
  close FN;
  return @ret;
}

sub linkinfo {
  my $fn = shift;
  my $fnc = readlink($fn);
  if (!defined($fnc)) {
    warn("$fn: $!\n");
    return ();
  }
  my $ctx = Digest::MD5->new;
  $ctx->add($fnc);
  return $ctx->hexdigest;
}

my @files;
my %cache;
my $cachehits = 0;
my $cachemisses = 0;

sub findfiles {
  my $bdir = shift;
  my $dir = shift;

  local *DH;
  if (!opendir(DH, "$bdir$dir")) {
    warn("$dir: $!\n");
    return;
  }
  my @ents = sort readdir(DH);
  closedir(DH);
  $bdir .= '/' if $dir eq '';
  $dir .= '/' if $dir ne '';
  for my $ent (@ents) {
    next if $ent eq '.' || $ent eq '..';
    next if $ent =~ /\.new\d*$/;
    my @s = lstat "$bdir$dir$ent";
    if (!@s) {
      warn("$bdir$dir$ent: $!\n");
      next;
    }
    next unless -l _ || -d _ || -f _;
    my $id = "$s[9]/$s[7]/$s[1]";
    my $mode = -l _ ? 0x2000 : -f _ ? 0x1000 : 0x0000;
    $mode |= $s[2] & 07777;
    my @data = ($id, sprintf("%04x%08x", $mode, $s[9]));
    if (-d _) {
      next if "$dir$ent" eq 'drpmsync';
      push @files, [ "$dir$ent", @data ];
      findfiles($bdir, "$dir$ent");
    } else {
      my @xdata;
      if ($cache{$id}) {
	@xdata = @{$cache{$id}};
	if (@xdata == ($ent =~ /\.[sr]pm/) ? 3 : 1) {
	  $cachehits++;
	  push @files, [ "$dir$ent", @data, @xdata ];
	  next;
	}
      }
      # print "miss $id ($ent)\n";
      $cachemisses++;
      if (-l _) {
        @xdata = linkinfo("$bdir$dir$ent");
        next if !@xdata;
	$cache{$id} = \@xdata;
	push @files, [ "$dir$ent", @data, @xdata ];
        next;
      }
      local *F;
      if (!open(F, "<$bdir$dir$ent")) {
	warn("$bdir$dir$ent: $!\n");
	next;
      }
      @s = stat F;
      if (!@s || ! -f _) {
	warn("$bdir$dir$ent: $!\n");
	next;
      }
      $id = "$s[9]/$s[7]/$s[1]";
      @data = ($id, sprintf("1%03x%08x", ($s[2] & 07777), $s[9]));
      if ($ent =~ /\.[sr]pm/) {
	@xdata = rpminfo_f(*F, "$bdir$dir$ent");
      } else {
	@xdata = fileinfo_f(*F, "$bdir$dir$ent");
      }
      close F;
      next if !@xdata;
      $cache{$id} = \@xdata;
      push @files, [ "$dir$ent", @data, @xdata ];
    }
  }
}

sub readcache {
  my $cf = shift;

  local *CF;
  open(CF, "<$cf") || return;
  while(<CF>) {
    chomp;
    my @s = split(' ');
    next unless @s == 4 || @s == 2;
    my $s = shift @s;
    $cache{$s} = \@s;
  }
  close CF;
}

sub writecache {
  my $cf = shift;

  local *CF;
  open(CF, ">$cf.new") || die("$cf.new: $!\n");
  for (@files) {
    next if @$_ < 4;	# no need to cache dirs
    if (@$_ > 4) {
      print CF "$_->[1] $_->[3] $_->[4] $_->[5]\n";
    } else {
      print CF "$_->[1] $_->[3]\n";
    }
  }
  close CF;
  rename("$cf.new", $cf) || die("rename $cf.new $cf: $!\n");
}

#######################################################################
# Server stuff
#######################################################################

sub escape {
  my $x = shift;
  $x =~ s/\&/&amp;/g;
  $x =~ s/\</&lt;/g;
  $x =~ s/\>/&gt;/g;
  $x =~ s/\"/&quot;/g;
  return $x;
}

sub aescape {
  my $x = shift;
  $x =~ s/([\000-\040<>\"#&\+=%[\177-\377])/sprintf("%%%02X",ord($1))/ge;
  return $x;
}

sub descape {
  my $x = shift;
  return $x;
}

# cannot use IPC::Open3, sigh...

sub runprg {
  my ($fg, @prg) = @_;
  my ($out, $err) = ('', '');
  local (*O, *OW, *E, *EW);
  pipe(O, OW) || die("pipe: $!\n");
  pipe(E, EW) || die("pipe: $!\n");
  my $pid = fork();
  return ('', "runprg: $!\n") if !defined($pid);
  if ($pid == 0) {
    close(O);
    close(E);
    if (fileno(OW) != 1) {
      open(STDOUT, ">&OW") || die("dup stdout: $!\n");
      close(O);
    }
    if (fileno(EW) != 2) {
      open(STDERR, ">&EW") || die("dup stderr: $!\n");
      close(O);
    }
    if (defined($fg)) {
      local (*I) = $fg;
      if (fileno(I) != 0) {
        open(STDIN, "<&I") || die("dup stdin: $!\n");
        close(I);
      }
    } else {
      open(STDIN, "</dev/null");
    }
    exec @prg;
    die("$prg[0]: $!\n");
  }
  close(OW);
  close(EW);
  my $rin = '';
  my $ofd = fileno(O);
  my $efd = fileno(E);
  vec($rin, $ofd, 1) = 1;
  vec($rin, $efd, 1) = 1;
  my $nfound;
  my $rout;
  my $openfds = 3;
  while ($openfds) {
    $nfound = select($rout = $rin, undef, undef, undef);
    if (!defined($nfound)) {
      $err .= "select: $!";
      close(O);
      close(E);
      last;
    }
    if (vec($rout, $ofd, 1)) {
      if (!sysread(O, $out, 4096, length($out))) {
	vec($rin, $ofd, 1) = 0;
	close(O);
	$openfds &= ~1;
      }
    }
    if (vec($rout, $efd, 1)) {
      if (!sysread(E, $err, 4096, length($err))) {
	vec($rin, $efd, 1) = 0;
	close(E);
	$openfds &= ~2;
      }
    }
  }
  kill 9, $pid;
  waitpid($pid, 0);
  return($out, $err);
}

sub readfile {
  my $fn = shift;
  local *FN;
  open(FN, "<$fn") || return ('', "$fn: $!");
  my $out = '';
  while ((sysread(FN, $out, 8192, length($out)) || 0) == 8192) {}
  close FN;
  return ($out, '');
}

# server config
my %trees;
my %chld;
my $standalone;
my $sendlogid;
my $servername;
my $serveraddr;
my $serveruser;
my $servergroup;
my $serverlog;
my $maxclients = 10;

sub readconfig_server {
  my $cf = shift;

  my @allow;
  my @deny;
  my $no_combine;
  my $log;
  my $slog;
  local *CF;
  die("config not set\n") unless $cf;
  open(CF, "<$cf") || die("$cf: $!\n");
  while(<CF>) {
    chomp;
    s/^\s+//;
    s/\s+$//;
    next if $_ eq '' || /^#/;
    my @s = split(' ', $_);
    $s[0] = lc($s[0]);
    if ($s[0] eq 'allow:' || $s[0] eq 'deny:') {
      my $w = shift @s;
      $w =~ s/://;
      for (@s) {
	if (/^\/(.*)\/$/) {
	  $_ = $1;
	  eval { local $::SIG{'__DIE__'}; "" =~ /^$_$/; };
	  die("$w: bad regexp: $_\n") if $@;
	} else {
	  s/([^a-zA-Z0-9*])/\\$1/g;
	  s/\*/.*/g;
	}
      }
      if ($w eq 'allow') {
	@allow = @s;
      } else {
	@deny = @s;
      }
    } elsif ($s[0] eq 'no_combine:') {
      $no_combine = ($s[1] && $s[1] =~ /true/i);
    } elsif ($s[0] eq 'log:') {
      $log = @s > 1 ? $s[1] : undef;
    } elsif ($s[0] eq 'serverlog:') {
      $slog = @s > 1 ? $s[1] : undef;
    } elsif ($s[0] eq 'deltarpmpath:') {
      my $p = defined($s[1]) ? "$s[1]/" : '';
      $makedeltarpm = "${p}makedeltarpm";
      $combinedeltarpm = "${p}combinedeltarpm";
    } elsif ($s[0] eq 'maxclients:') {
      $maxclients = $s[1] || 1;
    } elsif ($s[0] eq 'servername:') {
      $servername = $s[1];
    } elsif ($s[0] eq 'serveraddr:') {
      $serveraddr = $s[1];
    } elsif ($s[0] eq 'serveruser:') {
      $serveruser = $s[1];
    } elsif ($s[0] eq 'servergroup:') {
      $servergroup = $s[1];
    } elsif ($s[0] eq 'tree:') {
      shift @s;
      die("tree: two arguments required\n") if @s != 2;
      $trees{$s[0]} = { 'allow' => [ @allow ], 
			'deny' => [ @deny ], 
			'no_combine' => $no_combine,
			'log' => $log,
			'root' => $s[1],
			'id' => $s[0] };
    } else {
      $s[0] =~ s/:$//;
      die("$cf: unknown configuration parameter: $s[0]\n");
    }
  }
  close CF;
  $serverlog = $slog;
}

sub gethead {
  my $h = shift;
  my $t = shift;

  my ($field, $data);
  $field = undef;
  for (split(/[\r\n]+/, $t)) {
    next if $_ eq '';
    if (/^[ \t]/) {
      next unless defined $field;
      s/^\s*/ /;
      $h->{$field} .= $_;
    } else {
      ($field, $data) = split(/\s*:\s*/, $_, 2);
      $field =~ tr/A-Z/a-z/;
      if ($h->{$field} && $h->{$field} ne '') {
        $h->{$field} = $h->{$field}.','.$data;
      } else {
        $h->{$field} = $data;
      }
    }
  }
}

sub serverlog {
  my $id = shift;
  my $str = shift;
  return unless $serverlog;
  $str =~ s/\n$//s;
  my @lt = localtime(time()); 
  $lt[5] += 1900;
  $lt[4] += 1;
  $id = defined($id) ? " [$id]" : '';
  printf SERVERLOG "%04d-%02d-%02d %02d:%02d:%02d%s: %s\n", @lt[5,4,3,2,1,0], $id, $str;
}

sub serverdetach {
  my $pid;
  local(*SR, *SW);
  pipe(SR, SW) || die("setsid pipe: $!\n");
  while (1) {
    $pid = fork();
    last if defined($pid);
    sleep(10);
  }
  if ($pid) {
    close(SW);
    my $dummy = '';
    sysread(SR, $dummy, 1);
    exit(0);
  }
  POSIX::setsid();
  close(SW);
  close(SR);
  open(STDIN, "</dev/null");
  open(STDOUT, ">/dev/null");
  open(STDERR, ">/dev/null");
}

sub startserver {
  my $config = shift;
  my $nobg = shift;

  # not called from web server, go for standalone
  $standalone = 1;
  readconfig_server($config);
  if ($serverlog && !open(SERVERLOG, ">>$serverlog")) {
    my $err = "$serverlog: $!\n";
    undef $serverlog;	# do not log in die hook
    die($err);
  }
  serverlog(undef, "server start");
  $servername = '' unless defined $servername;
  $servername = Net::Domain::hostfqdn().$servername if $servername eq '' || $servername =~ /^:\d+$/;
  die("need servername for standalone mode\n") unless $servername;
  if (defined($serveruser) && $serveruser =~ /[^\d]/) {
    my $uid = getpwnam($serveruser);
    die("$serveruser: unknown user\n") unless defined $uid;
    $serveruser = $uid;
  }
  if (defined($servergroup) && $servergroup =~ /[^\d]/) {
    my $gid = getgrnam($servergroup);
    die("$servergroup: unknown group\n") unless defined $gid;
    $servergroup = $gid;
  }
  my ($servern, $servera, $serverp);
  ($servern, $serverp) = $servername =~ /^([^\/]+?)(?::(\d+))?$/;
  die("bad servername: $servername\n") unless $servern;
  $serverp ||= 80;
  $servera = INADDR_ANY;
  if ($serveraddr) {
    $servera = inet_aton($serveraddr) || die("could not resolv $serveraddr\n");
  }
  my $tcpproto = getprotobyname('tcp');
  socket(MS , PF_INET, SOCK_STREAM, $tcpproto) || die("socket: $!\n");
  setsockopt(MS, SOL_SOCKET, SO_REUSEADDR, pack("l",1));
  bind(MS, sockaddr_in($serverp, $servera)) || die "bind: $!\n";
  listen(MS , 512) || die "listen: $!\n";
  if (defined($servergroup)) {
    ($(, $)) = ($servergroup, $servergroup);
    die "setgid: $!\n" if $) != $servergroup;
  }
  if (defined($serveruser)) {
    ($<, $>) = ($serveruser, $serveruser);
    die "setuid: $!\n" if $> != $serveruser;
  }
  fcntl(MS, F_SETFL, 0);
  serverdetach() unless $nobg;
  my $remote_addr;
  while (1) {
    $remote_addr = accept(S, MS) || die "accept: $!\n";
    my $pid;
    while (1) {
      $pid = fork();
      last if defined($pid);
      sleep(10);
    }
    last if $pid == 0;
    close(S);
    $chld{$pid} = 1;
    $remote_addr = inet_ntoa((sockaddr_in($remote_addr))[1]);
    while(1) {
      $pid = waitpid(-1, keys %chld < $maxclients ? WNOHANG : 0);
      delete $chld{$pid} if $pid && $pid > 0;
      last if !($pid && $pid > 0) && keys %chld < $maxclients;
    }
  }
  $standalone = 2;
  $remote_addr = inet_ntoa((sockaddr_in($remote_addr))[1]);
  return $remote_addr;
}

sub parse_cgi {
  my ($cgip, $query_string) = @_;

  %$cgip = ();
  my @query_string = split('&', $query_string);
  while (@query_string) {
    my ($name, $value) = split('=', shift(@query_string), 2);
    next unless defined $name && $name ne '';
    $name  =~ tr/+/ /;
    $name  =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/ge;
    if (defined($value)) {
      $value =~ tr/+/ /;
      $value =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/ge;
    }
    $cgip->{$name} = $value;
  }
}

sub getrequest {
  my $qu = '';
  do {
    die($qu eq '' ? "empty query\n" : "received truncated query\n") if !sysread(S, $qu, 1024, length($qu));
  } while ($qu !~ /^(.*?)\r?\n/s);
  my $req = $1;
  my ($act, $path, $vers, undef) = split(' ', $req, 4);
  my %headers;
  die("400 No method name\n") if !$act;
  if ($vers ne '') {
    die("501 Bad method: $act\n") if $act ne 'GET' && $act ne 'HEAD' && $act ne 'POST';
    while ($qu !~ /^(.*?)\r?\n\r?\n(.*)$/s) {
      die("received truncated query\n") if !sysread(S, $qu, 1024, length($qu));
    }
    $qu =~ /^(.*?)\r?\n\r?\n(.*)$/s;
    $qu = $2;
    gethead(\%headers, "Request: $1");
  } elsif ($act ne 'GET') {
    die("501 Bad method, must be GET\n");
    $qu = '';
  }
  my $query_string = '';
  if ($path =~ /^(.*?)\?(.*)$/) {
    $path = $1;
    $query_string = $2;
  }
  if ($act eq 'POST') {
    $query_string = '';
    my $cl = $headers{'content-length'};
    while (length($qu) < $cl) {
      sysread(S, $qu, $cl - length($qu), length($qu)) || die("400 Truncated body\n");
    }
    $query_string = substr($qu, 0, $cl);
    $qu = substr($qu, $cl);
  }
  $path =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/ge;
  return ($path, $query_string, $headers{'via'} ? 1 : 0);
}

sub replystream  {
  local (*FF) = shift;
  my ($flen, $str, $ctx, @hi) = @_;

  die("replystream: bad param\n") unless $flen;
  unshift @hi, "HTTP/1.1 200 OK";
  push @hi, "Server: drpmsync";
  push @hi, "Cache-Control: no-cache";
  push @hi, "Content-length: ".(length($str) + $flen + 32);
  $str = join("\r\n", @hi)."\r\n\r\n".$str;
  if ($standalone) {
    fcntl(S, F_SETFL,O_NONBLOCK);
    my $dummy = '';
    1 while sysread(S, $dummy, 1024, 0);
    fcntl(S, F_SETFL,0);
  }
  my $r;
  while (length($str) || $flen) {
    if ($flen) {
      my $d;
      my $r = (sysread(FF, $d, 8192) || 0);
      die("read error: $!\n") unless $r;
      die("too much data\n") if $r > $flen;
      $ctx->add($d);
      $str .= $d;
      $flen -= $r;
      $str .= $ctx->hexdigest if !$flen;
    }
    $r = syswrite(S, $str, length($str));
    die("write error: $!\n") unless $r;
    $str = substr($str, $r);
  }
}

sub reply {
  my ($str, @hi) = @_;

  if ($standalone) {
    if (@hi && $hi[0] =~ /^status: (\d+.*)/i) {
      $hi[0] = "HTTP/1.1 $1";
    } else {
      unshift @hi, "HTTP/1.1 200 OK";
    }
  }
  push @hi, "Server: drpmsync";
  push @hi, "Cache-Control: no-cache";
  push @hi, "Content-length: ".length($str);
  my $data = join("\r\n", @hi)."\r\n\r\n$str";
  if (!$standalone) {
    print $data;
    return;
  }
  fcntl(S, F_SETFL,O_NONBLOCK);
  my $dummy = '';
  1 while sysread(S, $dummy, 1024, 0);
  fcntl(S, F_SETFL,0);
  my $l;
  while (length($data)) {
    $l = syswrite(S, $data, length($data));
    die("write error: $!\n") unless $l;
    $data = substr($data, $l);
  }
}

sub check_access {
  my ($tree, $remote_addr) = @_;
  my ($remote_name, $access_ok);
  if (@{$tree->{'deny'}}) {
    $remote_name = gethostbyaddr(inet_aton($remote_addr), AF_INET);
    die("could not resolve $remote_addr\n") unless $remote_name;
    for my $deny (@{$tree->{'deny'}}) {
      die("access denied [$remote_addr]\n") if $remote_name =~ /^$deny$/i;
      die("access denied [$remote_addr]\n") if $remote_addr =~ /^$deny$/i;
    }
  }
  for my $allow (@{$tree->{'allow'}}) {
    return if $remote_addr =~ /^$allow$/i;
  }
  $remote_name = gethostbyaddr(inet_aton($remote_addr), AF_INET) unless $remote_name;
  die("could not resolve $remote_addr\n") unless $remote_name;
  for my $allow (@{$tree->{'allow'}}) {
    return if $remote_name =~ /^$allow$/i;
  }
  die("access denied [$remote_addr]\n");
}

sub sendlog {
  my $str = shift;
  return unless $sendlogid;
  $str =~ s/\n$//s;
  my @lt = localtime(time()); 
  $lt[5] += 1900;
  $lt[4] += 1;
  printf SENDLOG "%04d-%02d-%02d %02d:%02d:%02d %s: %s\n", @lt[5,4,3,2,1,0], $sendlogid, $str;
}

if ($::ENV{'REQUEST_METHOD'} || (@ARGV && ($ARGV[0] eq '-s' || $ARGV[0] eq '-S'))) {
  # server mode

  my ($request_method, $script_name, $path_info, $query_string, $remote_addr, $has_via);
  my %cgi;
  my $tree;

  # setup die handler
  $::SIG{'__DIE__'} = sub {
    my $err = $_[0];
    serverlog($remote_addr, $err) if $serverlog && !$sendlogid;
    sendlog($err) if $sendlogid;
    die($err) if $standalone == 1;
    $err =~ s/\n$//s;
    if (exists($cgi{'drpmsync'})) {
      my $data = 'DRPMSYNC0001ERR 00000000'.sprintf("%08x", length($err)).$err;
      reply($data, "Content-type: application/octet-stream");
    } elsif ($err =~ /^(\d+[^\r\n]*)/) {
      reply("<pre>$err</pre>\n", "Status: $1", "Content-type: text/html");
    } else {
      reply("<pre>$err</pre>\n", "Status: 404 Error", "Content-type: text/html");
    }
    exit 0;
  };

  $request_method = $::ENV{'REQUEST_METHOD'};
  if (!$request_method) {
    $remote_addr = startserver($ARGV[1], $ARGV[0] eq '-S' ? 1 : 0);
nextreq:
    my $path;
    ($path, $query_string, $has_via) = getrequest(\%cgi);
    $request_method = 'GET';
    parse_cgi(\%cgi, $query_string);
    my @mtrees = grep {$path eq $_->{'id'} || substr($path, 0, length($_->{'id'}) + 1) eq "$_->{'id'}/" } sort {length($b->{'id'}) <=> length($a->{'id'})} values %trees;
    die("not exported\n") unless @mtrees;
    $script_name = $mtrees[0]->{'id'};
    $path_info = substr($path, length($script_name));
  } else {
    $script_name = $::ENV{'SCRIPT_NAME'};
    $path_info = $::ENV{'PATH_INFO'};
    $query_string = $::ENV{'QUERY_STRING'};
    $remote_addr = $::ENV{'REMOTE_ADDR'};
    if ($request_method eq 'POST') {
      $query_string = '';
      read(STDIN, $query_string, 0 + $::ENV{'CONTENT_LENGTH'});
    }
    parse_cgi(\%cgi, $query_string);
  }
  if (!$standalone) {
    my $config = $::ENV{'DRPMSYNC_CONFIG'};
    readconfig_server($config);
  }
  $path_info = '' unless defined $path_info;
  die("invalid path\n") if $path_info =~ /\/(\.|\.\.)?\//;
  die("invalid path\n") if $path_info =~ /\/(\.|\.\.)$/;
  die("invalid path\n") if "$path_info/" =~ /(\.|\.\.)\//;
  die("invalid path\n") if $path_info ne '' && ($path_info !~ /^\//);
  die("$script_name not exported\n") unless $trees{$script_name};

  my $sendlog = $trees{$script_name}->{'log'};
  if ($tree && $tree->{'log'} && (!$sendlog || $tree->{'log'} ne $sendlog)) {
      close(SENDLOG);
      undef $sendlogid;
  }
  if ($sendlog && (!$tree || !$tree->{'log'} || $tree->{'log'} ne $sendlog)) {
    open(SENDLOG, ">>$sendlog") || die("$sendlog: $!\n");
    select(SENDLOG);
    $| = 1;
    select(STDOUT);
    $sendlogid = "[$remote_addr] $trees{$script_name}->{'id'}";
  }
  $tree = $trees{$script_name};
  check_access($tree, $remote_addr);
  my $spath_info = $path_info;
  $spath_info =~ s/^\///;

  my $root = $tree->{'root'};

  die("$root: $!\n") unless -d $root;

  my $replyid = $standalone && !$has_via && exists($cgi{'drpmsync'}) ? 'DRPMSYNK' : 'DRPMSYNC';

  if ($path_info =~ /(.*)\/drpmsync\/closesock$/ && exists $cgi{'drpmsync'}) {
    my $croot = $1;
    sendlog(". $croot bye");
    close(S);
    exit(0);
  }

  if ($path_info =~ /^(.*)\/drpmsync\/contents$/) {
    my $croot = $1;
    die("$croot: does not exist\n") unless -e "$root$croot";
    die("$croot: not a directory\n") unless -d "$root$croot";
    readcache("$root$croot/drpmsync/cache");
    findfiles("$root$croot", "");
    my ($stamp1, $stamp2);
    $stamp1 = $stamp2 = sprintf("%08x", time());
    if (open(STAMP, "<$root$croot/drpmsync/timestamp")) {
      my $s = '';
      if ((sysread(STAMP, $s, 16) || 0) == 16 && $s !~ /[^0-9a-z]/) {
        $stamp1 = substr($s, 0, 8);
        $stamp2 = substr($s, 8, 8);
      }
      close STAMP;
    }
    my $data = '';
    if (!exists $cgi{'drpmsync'}) {
      for (@files) {
        my @l = @$_;
        $l[0] = aescape($l[0]);
        $l[5] = aescape($l[5]) if @l > 5;
        splice(@l, 1, 1);
        $data .= join(' ', @l)."\n";
      }
      sendlog("h $croot contents ($cachehits/$cachemisses)");
      reply($data, "Content-type: text/plain");
      exit(0);
    }
    $data = pack('H*', "$stamp1$stamp2");
    $data = pack("Nw/a*w/a*", scalar(@files), $tree->{'id'}, $data);
    for (@files) {
      my @l = @$_;
      my $b;
      if (@l > 4) {
        $b = pack('H*', "$l[2]$l[3]$l[4]").$l[5];
      } elsif (@l > 3) {
        $b = pack('H*', "$l[2]$l[3]");
      } else {
        $b = pack('H*', $l[2]);
      }
      $data .= pack("w/a*w/a*", $l[0], $b);
    }
    my $dataid = 'SYNC';
    if ($have_zlib && exists($cgi{'zlib'})) {
      $data = Compress::Zlib::compress($data);
      $dataid = 'SYNZ';
      sendlog("z $croot contents ($cachehits/$cachemisses)");
    } else {
      sendlog("f $croot contents ($cachehits/$cachemisses)");
    }
    $data = sprintf("1%03x%08x", 0644, time()).$data;
    $data = "${replyid}0001${dataid}00000000".sprintf("%08x", length($data)).$data.Digest::MD5::md5_hex($data);
    reply($data, "Content-type: application/octet-stream");
    goto nextreq if $replyid eq 'DRPMSYNK';
    exit(0);
  }

  if (-d "$root$path_info") {
    if (($path_info !~ s/\/$//)) {
      if ($standalone) {
	reply("The document has moved", "Status: 302 Found", "Content-type: text/html", "Location: http://$servername$tree->{'id'}$path_info/");
      } else {
	reply("The document has moved", "Status: 302 Found", "Content-type: text/html", "Location: http://$ENV{'SERVER_NAME'}$tree->{'id'}$path_info/");
      }
      exit(0);
    }
    sendlog("h $path_info");
    opendir(DIR, "$root$path_info") || die("$root$path_info: $!\n");
    my @ents = sort readdir(DIR);
    closedir DIR;
    @ents = grep {$_ ne '.' && $_ ne '..'} @ents;
    unshift @ents, '.', '..';
    my $data = "<pre>\n";
    for my $ent (@ents) {
      my @s = lstat("$root$path_info/$ent");
      if (!@s) {
	$data .= escape("$ent: $!\n");
	next;
      }
      my $ent2 = '';
      my $info = '?';
      $info = 'c' if -c _;
      $info = 'b' if -b _;
      $info = '-' if -f _;
      $info = 'd' if -d _;
      if (-l _) {
	$info = 'l';
	$ent2 = readlink("$root$path_info/$ent");
	die("$root$path_info/$ent: $!") unless defined $ent2;
	$ent2 = escape(" -> $ent2");
      }
      my $mode = $s[2] & 0777;
      for (split('', 'rwxrwxrwx')) {
	$info .= $mode & 0400 ? $_ : '-';
	$mode *= 2;
      }
      my @lt = localtime($s[9]);
      $lt[4] += 1;
      $lt[5] += 1900;
      $info = sprintf("%s %4d root root %8d %04d-%02d-%02d %02d:%02d:%02d", $info, $s[3], $s[7], @lt[5, 4, 3, 2, 1, 0]);
      $info = escape($info);
      my $ne = "$path_info/$ent";
      $ne = $path_info if $ent eq '.';
      if ($ent eq '..') {
	$ne = $path_info;
	$ne =~ s/[^\/]+$//;
	$ne =~ s/\/$//;
      }
      if ((-d _) && ! (-l _)) {
	$ent = "<a href=\"".aescape("$script_name$ne/")."\">".escape("$ent")."</a>$ent2";
      } elsif ((-f _) && ! (-l _)) {
	$ent = "<a href=\"".aescape("$script_name$ne")."\">".escape("$ent")."</a>$ent2";
      } else {
	$ent = escape("$ent").$ent2;
      }
      $data .= "$info $ent\n";
    }
    $data .= "</pre>\n";
    reply($data, "Content-type: text/html");
    exit(0);
  }

  if (!exists $cgi{'drpmsync'}) {
    sendlog("h $path_info");
    my @s = lstat("$root$path_info");
    die("$spath_info: $!\n") unless @s;
    die("$spath_info: bad file type\n") unless (-f _) && ! (-l _);
    open(F, '<', "$root$path_info") || die("$spath_info: $!\n");
    my $c = '';
    while ((sysread(F, $c, 4096, length($c)) || 0) == 4096) {}
    close F;
    my $ct = 'text/plain';
    if ($spath_info =~ /\.(gz|rpm|spm|bz2|tar|tgz|jpg|jpeg|gif|png|pdf)$/) {
      $ct = 'application/octet-stream';
    }
    reply($c, "Content-type: $ct");
    exit(0);
  }

  my @s = lstat("$root$path_info");
  if (!@s) {
    sendlog("- $path_info");
    my $data = 'DRPMSYNC0001GONE'.sprintf("%08x", length($spath_info)).'00000000'.$spath_info;
    reply($data, "Content-type: application/octet-stream");
    exit(0);
  }
  if (-l _) {
    sendlog("f $path_info");
    my $lc = readlink("$root$path_info");
    die("readlink: $!\n") unless defined($lc);
    $lc = sprintf("2%03x%08x", $s[2] & 07777, $s[9]).$lc;
    my $data = "${replyid}0001FILE".sprintf("%08x%08x", length($spath_info), length($lc)).$spath_info.$lc.Digest::MD5::md5_hex($lc);
    reply($data, "Content-type: application/octet-stream");
    goto nextreq if $replyid eq 'DRPMSYNK';
    exit(0);
  }
  die("Bad file type\n") unless -f _;
  open(F, "<$root$path_info") || die("$spath_info: $!\n");

  if ($spath_info !~ /\.[sr]pm$/) {
    my $data = sprintf("1%03x%08x", $s[2] & 07777, $s[9]);
    while ((sysread(F, $data, 4096, length($data)) || 0) == 4096) {}
    close F;
    my $dataid = 'FILE';
    if (length($data) >= 12 + 64 && $have_zlib && exists($cgi{'zlib'}) && substr($data, 12, 2) ne "\037\213" && substr($data, 12, 2) ne "BZ") {
      $data = substr($data, 0, 12).Compress::Zlib::compress(substr($data, 12));
      $dataid = 'FILZ';
      sendlog("z $path_info");
    } else {
      sendlog("f $path_info");
    }
    $data = "${replyid}0001$dataid".sprintf("%08x%08x", length($spath_info), length($data)).$spath_info.$data.Digest::MD5::md5_hex($data);
    reply($data, "Content-type: application/octet-stream");
    goto nextreq if $replyid eq 'DRPMSYNK';
    exit(0);
  }

  my $deltadata = '';
  my $deltaintro = '';
  my $deltanum = 0;
  my $sendrpm = exists($cgi{'withrpm'}) ? 1 : 0;
  my $key = '';
  if ($cgi{'have'}) {
    die("bad have parameter\n") unless $cgi{'have'} =~ /^[0-9a-f]{64}$/;
    my $have1 = substr($cgi{'have'}, 0, 32);
    my $have2 = substr($cgi{'have'}, 32, 32);
    my @info = rpminfo_f(*F, $spath_info);
    die("bad info\n") unless @info;
    seek(F, 0, 0);	# needed because of perl's autoflush
    # only sysread after this!
    defined(sysseek(F, 0, 0)) || die("sysseek: $!\n");
    my $info = $info[0];
    my $info1 = substr($info, 0, 32);
    my $info2 = substr($info, 32, 32);
    if ($have2 eq $info2) {
      # identical payload, create sign only delta
      # sendlog("$path_info: makedeltarpm sign only");
      my ($out, $err) = runprg(*F, $makedeltarpm, '-u', '-r', '-', '-');
      die("makedeltarpm failed: $err\n") if $err;
      $deltaintro .= sprintf("1%03x%08x$have2$info1$info2%08x", $s[2] & 07777, $s[9], length($out));
      $deltadata .= $out;
      $deltanum++;
      $key = 's';
      $sendrpm = 0;	# no need to send full rpm in this case
    } else {
      # ok, lets see if we can build a chain from have2 to info2
      my $dpn = $info[2];
  lost_delta:
      $key = '';
      $deltadata = '';
      $deltaintro = '';
      $deltanum = 0;

      my $deltadir = "$root$path_info";
      if ($path_info ne '') {
        $deltadir =~ s/[^\/]+$//;
        $deltadir =~ s/\/$//;
        while ($deltadir ne $root) {
	  last if -d "$deltadir/drpmsync/deltas";
          $deltadir =~ s/[^\/]+$//;
          $deltadir =~ s/\/$//;
	}
      }
      $deltadir = "$deltadir/drpmsync/deltas/$dpn";
      my @avail = ();
      if (opendir(D, $deltadir)) {
	@avail = readdir(D);
	closedir D;
	@avail = grep {/^[0-9a-f]{96}$/} @avail;
	@avail = grep {-f "$deltadir/$_"} @avail;
      }
      my %avail;
      push @{$avail{substr($_, 0, 32)}}, $_ for @avail;
      my @chains = ([$have2]);
      my $solution;
      while (@chains && @{$chains[0]} < @avail + 1 && !$solution) {
	for my $pos (splice @chains) {
	  for my $a (@{$avail{$pos->[0]}}) {
	    my @n = (@$pos, $a);
	    $n[0] = substr($a, 64, 32);
	    push @chains, \@n;
	    $solution = \@n if $n[0] eq $info2;
	  }
	}
      }
      if ($solution) {
	my @solution = @$solution;
	shift @solution;
	# sendlog("$path_info: solution @solution");
	die unless @solution;
	my @combine = ();
        $key = scalar(@solution) if @solution > 1;
        $key .= 'd';
	for my $dn (@solution) {
	  push @combine, $dn;
	  next if @combine < @solution && !exists($cgi{'uncombined'}) && !$tree->{'no_combine'};
	  my @ds = stat("$deltadir/$combine[0]");
	  goto lost_delta if !@ds || ! (-f _);
	  my ($out, $err);
	  if ($dn eq $solution[-1] && substr($dn, 32, 32) ne $info1) {
	    # sendlog("$path_info: combinedeltarpm -S @combine");
	    ($out, $err) = runprg(*F, $combinedeltarpm, '-S', '-', (map {"$deltadir/$_"} @combine), '-');
	    defined(sysseek(F, 0, 0)) || die("sysseek: $!\n");
	    substr($combine[-1], 32, 32) = $info1;
	    $key .= 's';
	  } elsif (@combine > 1) {
	    # sendlog("$path_info: combinedeltarpm @combine");
	    ($out, $err) = runprg(undef, $combinedeltarpm, (map {"$deltadir/$_"} @combine), '-');
	  } else {
	    # sendlog("$path_info: readfile @combine");
	    ($out, $err) = readfile("$deltadir/$dn");
	  }
	  if ($err) {
	    goto lost_delta if grep {! -f "$deltadir/$_"} @combine;
	    $err =~ s/\n$//s;
	    die("$err\n");
	  }
	  $deltaintro .= sprintf("1%03x%08x".substr($combine[0], 0, 32).substr($combine[-1], 32, 64)."%08x", $ds[2] & 07777, $ds[9], length($out));
	  $deltadata .= $out;
	  $deltanum++;
	  @combine = ();
	}
        $key .= $deltanum if $deltanum != 1;
      }
    }
  }
  $sendrpm = 1 if !$deltanum;
  $key .= 'r' if $sendrpm;
  $key = '?' if $key eq '';
  sendlog("$key $path_info");
  if ($sendrpm) {
    my $flen = -s F;
    if ($flen > 100000) {
      my $data = sprintf("1%03x%08x", $s[2] & 07777, $s[9]);
      $data .= sprintf("%08x%08x", $deltanum, $sendrpm).$deltaintro.$deltadata;
      my $ctx = Digest::MD5->new;
      $ctx->add($data);
      $data = "${replyid}0001RPM ".sprintf("%08x%08x", length($spath_info), length($data) + $flen).$spath_info.$data;
      replystream(*F, $flen, $data, $ctx, "Content-type: application/octet-stream");
      close F;
      goto nextreq if $replyid eq 'DRPMSYNK';
      exit(0);
    }
  }
  my $rdata = '';
  if ($sendrpm) {
    while ((sysread(F, $rdata, 4096, length($rdata)) || 0) == 4096) {}
  }
  my $data = sprintf("1%03x%08x", $s[2] & 07777, $s[9]);
  $data .= sprintf("%08x%08x", $deltanum, $sendrpm).$deltaintro.$deltadata.$rdata;
  $data = "${replyid}0001RPM ".sprintf("%08x%08x", length($spath_info), length($data)).$spath_info.$data.Digest::MD5::md5_hex($data);
  reply($data, "Content-type: application/octet-stream");
  close F;
  goto nextreq if $replyid eq 'DRPMSYNK';
  exit(0);
}

#######################################################################
# Client code
#######################################################################

my @config_source;
my $config_generate_deltas;
my $config_keep_deltas;
my $config_keep_uncombined;
my $config_always_get_rpm;
my @config_generate_delta_compression;
my $config_recvlog;
my $config_delta_max_age;

my $syncport;
my $syncaddr;
my $syncurl;
my $syncroot;
my $esyncroot;
my $synctree = '';
my $synchost = Net::Domain::hostfqdn();

my $newstamp1;
my $newstamp2;

my $txbytes = 0;
my $rvbytes = 0;
my $sabytes = 0;

sub readconfig_client {
  my $cf = shift;
  local *CF;
  open(CF, "<$cf") || die("$cf: $!\n");
  while (<CF>) {
    chomp;
    s/^\s+//;
    s/\s+$//;
    next if $_ eq '' || /^#/;
    my @s = split(' ', $_);
    $s[0] = lc($s[0]);
    if ($s[0] eq 'source:') {
      shift @s;
      @config_source = @s;
    } elsif ($s[0] eq 'generate_deltas:') {
      $config_generate_deltas = ($s[1] && $s[1] =~ /true/i);
    } elsif ($s[0] eq 'generate_delta_compression:') {
      @config_generate_delta_compression = ();
      @config_generate_delta_compression = ('-z', $s[1]) if $s[1];
    } elsif ($s[0] eq 'keep_deltas:') {
      $config_keep_deltas = ($s[1] && $s[1] =~ /true/i);
    } elsif ($s[0] eq 'keep_uncombined:') {
      $config_keep_uncombined = ($s[1] && $s[1] =~ /true/i);
    } elsif ($s[0] eq 'always_get_rpm:') {
      $config_always_get_rpm = ($s[1] && $s[1] =~ /true/i);
    } elsif ($s[0] eq 'delta_max_age:') {
      $config_delta_max_age = @s > 1 ? $s[1] : undef;
    } elsif ($s[0] eq 'deltarpmpath:') {
      my $p = defined($s[1]) ? "$s[1]/" : '';
      $makedeltarpm = "${p}makedeltarpm";
      $combinedeltarpm = "${p}combinedeltarpm";
      $applydeltarpm = "${p}applydeltarpm";
    } elsif ($s[0] eq 'log:') {
      $config_recvlog = @s > 1 ? $s[1] : undef;
    } else {
      $s[0] =~ s/:$//;
      die("$cf: unknown configuration parameter: $s[0]\n");
    }
  }
  $config_keep_deltas ||= $config_generate_deltas;
  $config_keep_deltas ||= $config_keep_uncombined;
  close CF;
}

#######################################################################

sub mkdir_p {
  my $dir = shift;
  return if -d $dir;
  mkdir_p($1) if $dir =~ /^(.*)\//;
  mkdir($dir, 0777) || die("mkdir: $dir: $!\n");
}

#######################################################################

sub toiso {
  my @lt = localtime($_[0]);
  $lt[5] += 1900;
  $lt[4] += 1;
  return sprintf "%04d-%02d-%02d %02d:%02d:%02d", @lt[5,4,3,2,1,0];
}

#######################################################################

sub recvlog {
  my $str = shift;

  return unless $config_recvlog;
  my @lt = localtime(time());
  $lt[5] += 1900;
  $lt[4] += 1;
  printf RECVLOG "%04d-%02d-%02d %02d:%02d:%02d %s\n", @lt[5,4,3,2,1,0], $str;
}

sub recvlog_print {
  my $str = shift;
  print "$str\n";
  recvlog($str);
}

#######################################################################

sub tolength {
  local (*SOCK) = shift;
  my ($ans, $l) = @_;
  while (length($ans) < $l) {
    die("received truncated answer\n") if !sysread(SOCK, $ans, $l - length($ans), length($ans));
  }
  return $ans;
}

sub copytofile {
  local (*SOCK) = shift;
  my ($fn, $ans, $l, $ctx) = @_;

  local *FD;
  open(FD, ">$fn") || die("$fn: $!\n");
  my $al = length($ans);
  if ($al >= $l) {
    die("$fn: write error\n") if syswrite(FD, $ans, $l) != $l;
    die("$fn: write error\n") unless close(FD);
    $ctx->add(substr($ans, 0, $l));
    return substr($ans, $l);
  }
  if ($al > 0) {
    die("$fn: write error\n") if syswrite(FD, $ans, $al) != $al;
    $ctx->add($ans);
    $l -= $al;
    $ans = '';
  }
  while ($l > 0) {
    die("received truncated answer\n") if !sysread(SOCK, $ans, $l > 8192 ? 8192 : $l, 0);
    $al = length($ans);
    die("$fn: write error\n") if syswrite(FD, $ans, $al) != $al;
    $ctx->add($ans);
    $l -= $al;
    $ans = '';
  }
  die("$fn: write error\n") unless close(FD);
  return '';
}

sub checknetmd5 {
  local (*SOCK) = shift;
  my $ans = shift;
  my $ctx = shift;

  $ans = tolength(*SOCK, $ans, 32);
  my $netmd5 = substr($ans, 0, 32);
  die("network error: bad md5 digest\n") if $netmd5 =~ /[^a-z0-9]/;
  my $md5 = $ctx->hexdigest;
  die("network error: $md5 should be $netmd5\n") if $md5 ne $netmd5;
  return substr($ans, 32);
}

sub makedelta {
  my ($from, $to, $drpm) = @_;
  # print "makedeltarpm $from $to\n";
  system($makedeltarpm, @config_generate_delta_compression, '-r', $from, $to, $drpm) && die("makedeltarpm failed\n");
  die("makedeltarpm did not create delta\n") unless -s $drpm;
  return $drpm;
}

sub applydeltas {
  my ($from, $to, @deltas) = @_;
  my $dn = $deltas[0];
  if (@deltas > 1) {
    my $ddir = $deltas[0];
    $ddir =~ s/\/[^\/]+$//;
    my $d1 = $deltas[0];
    my $d2 = $deltas[-1];
    my @d1s = stat($d1);
    die("$d1: $!\n") if !@d1s;
    $d1 =~ s/.*\///;
    $d2 =~ s/.*\///;
    $dn = "$ddir/".substr($d1, 0, 32).substr($d2, 32, 64);
    die("combined delta already exists?\n") if -f $dn;
    # print "combinedeltarpm @deltas\n";
    system($combinedeltarpm, @deltas, $dn) && die("combinedeltarpm failed\n");
    die("combinedeltarpm did not create delta\n") unless -s $dn;
    utime($d1s[9], $d1s[9], $dn);
  }
  # print "applydeltarpm $from $dn\n";
  system($applydeltarpm, '-r', $from, $dn, $to) && die("applydeltarpm failed\n");
  die("applydeltarpm did not create rpm\n") unless -s $to;
  if ($config_keep_uncombined || @deltas <= 1) {
    if (@deltas > 1) {
      unlink($dn) || die("unlink $dn: $!\n");
    }
    return @deltas;
  }
  for my $d (@deltas) {
    unlink($d) || die("unlink $d: $!\n");
  }
  return ($dn);
}


my %files;

sub dirchanged {
  my $dir = shift;
  $dir =~ s/[^\/]+$//;
  $dir =~ s/\/+$//;
  return unless $dir ne '';
  my $d = $files{$dir};
  return unless $d && $d->[2] =~ /^0/;
  $d->[2] = substr($d->[2], 0, 4)."ffffffff";
}

my $sock_isopen;

sub opensock {
  return if $sock_isopen;
  my $tcpproto = getprotobyname('tcp');
  socket(S, PF_INET, SOCK_STREAM, $tcpproto) || die("socket: $!\n");
  connect(S, sockaddr_in($syncport, $syncaddr)) || die("connect: $!\n");
  $sock_isopen = 1;
}

# called for files and rpms
sub update {
  my $bdir = shift;
  my $dto = shift;

  die("can only update files and symlinks\n") if $dto->[2] !~ /^[12]/;
  my $d = $files{$dto->[0]};
  if ($d && $d->[3] eq $dto->[3]) {
    return if $d->[2] eq $dto->[2];	# already identical
    if (substr($d->[2], 0, 1) eq substr($dto->[2], 0, 1)) {
      return if substr($d->[2], 0, 1) eq '2';	# can't change links
      fixmodetime("$bdir/$d->[0]", $dto->[2]);
      $d->[2] = $dto->[2];
      my $newmtime = hex(substr($dto->[2], 4, 8));
      $d->[1] =~ s/^.*?\//$newmtime\//;
      return;
    }
  }

  if (!$d && @$dto > 5) {
    my @oldds = grep {@$_ > 5 && $_->[5] eq $dto->[5]} values %files;
    $d = $oldds[0] if @oldds;
  }

  # recvlog_print("update $dto->[0]");
  my $req = aescape($dto->[0]);
  $req = "/$req?drpmsync";
  if ($d && ($d->[2] =~ /^1/) && ($d->[0] =~ /\.[sr]pm$/)) {
    $req .= "&have=$d->[3]";
    $req .= "&uncombined" if $config_keep_uncombined;
    $req .= "&withrpm" if $config_always_get_rpm && substr($d->[3], 32) ne substr($dto->[3], 32);
  } elsif ($have_zlib) {
    $req .= "&zlib";
  }

  opensock() unless $sock_isopen;
  my $query = "GET $esyncroot$req HTTP/1.0\r\nHost: $synchost\r\n\r\n";
  $txbytes += length($query);
  if (syswrite(S, $query, length($query)) != length($query)) {
    die("network write failed\n");
  }
  my $ans = '';
  do {
    die("received truncated answer\n") if !sysread(S, $ans, 1024, length($ans));
  } while ($ans !~ /\n\r?\n/s);
  $rvbytes += length($ans);
  $ans =~ /\n\r?\n(.*)$/s;
  $rvbytes -= length($1);
  $ans = tolength(*S, $1, 32);
  my $id = substr($ans, 0, 8);
  die("received bad answer: $ans\n") if $id ne 'DRPMSYNC' && $id ne 'DRPMSYNK';
  my $vers = hex(substr($ans, 8, 4));
  die("answer has bad version\n") if $vers != 1;
  my $type = substr($ans, 12, 4);
  my $namelen = hex(substr($ans, 16, 8));
  my $anssize = hex(substr($ans, 24, 8));
  $rvbytes += 32 + $namelen + $anssize + 32;
  if ($type eq 'ERR ') {
    $ans = tolength(*S, $ans, 32 + $namelen + $anssize);
    die("remote error: ".substr($ans, 32 + $namelen, $anssize)."\n");
  }
  $ans = tolength(*S, $ans, 32 + $namelen);
  die("answer does not match request $syncroot/$dto->[0] - $synctree".substr($ans, 32, $namelen)."\n") if "$syncroot/$dto->[0]" ne $synctree.substr($ans, 32, $namelen);
  $ans = substr($ans, 32 + $namelen);
  die("$dto->[0] is gone\n") if $type eq 'GONE';
  my $extra = '';

  my $extralen = 12;
  $extralen = 12 + 16 if $type eq 'RPM ';

  die("answer is too short\n") if $anssize < $extralen;
  my $ctx = Digest::MD5->new;
  my $ndrpm = 0;
  my $nrpm = 0;
  if ($extralen) {
    $ans = tolength(*S, $ans, $extralen);
    $extra = substr($ans, 0, $extralen);
    die("illegal extra block\n") if $extra =~ /[^a-z0-9]/;
    if ($type eq 'RPM ') {
      $ndrpm = hex(substr($extra, 12, 8));
      $nrpm = hex(substr($extra, 12 + 8, 8));
      die("more than one rpm?\n") if $nrpm > 1;
      if ($ndrpm) {
        $extralen += $ndrpm * (12 + 32 * 3 + 8);
        $ans = tolength(*S, $ans, $extralen);
        $extra = substr($ans, 0, $extralen);
        die("illegal extra block\n") if $extra =~ /[^a-z0-9]/;
      }
    }
    $ans = substr($ans, $extralen);
    $anssize -= $extralen;
    $ctx->add($extra);
  }
  my $pn = $dto->[0];
  $pn =~ s/^.*\///;
  die("no file name??") if $pn eq '';

  if ($type eq 'FILZ') {
    recvlog_print("z $dto->[0]");
    die("cannot uncompress\n") unless $have_zlib;
    my $tmpnam = "$bdir/drpmsync/wip/$pn";
    $ans = tolength(*S, $ans, $anssize);
    my $data = substr($ans, 0, $anssize);
    $ctx->add($data);
    $ans = checknetmd5(*S, substr($ans, $anssize), $ctx);
    $data = Compress::Zlib::uncompress($data);
    if ($dto->[2] =~ /^2/) {
      symlink($data, $tmpnam) || die("symlink: $!\n");
    } else {
      open(FD, ">$tmpnam") || die("$tmpnam: $!\n");
      die("$tmpnam: write error\n") if (syswrite(FD, $data) || 0) != length($data);
      close(FD) || die("$tmpnam: $!\n");
    }
    fixmodetime($tmpnam, substr($extra, 0, 12)) if $dto->[2] !~ /^2/;
    my @s = lstat($tmpnam);
    die("$tmpnam: $!\n") unless @s;
    if ($dto->[2] =~ /^2/) {
      $files{$dto->[0]} = [ $dto->[0], "$s[9]/$s[7]/$s[1]", sprintf("2%03x%08x", ($s[2] & 07777), $s[9]), linkinfo($tmpnam) ];
    } else {
      $files{$dto->[0]} = [ $dto->[0], "$s[9]/$s[7]/$s[1]", sprintf("1%03x%08x", ($s[2] & 07777), $s[9]), fileinfo($tmpnam) ];
    }
    rename($tmpnam, "$bdir/$dto->[0]") || die("rename $tmpnam $bdir/$dto->[0]: $!\n");
  } elsif ($type eq 'FILE') {
    recvlog_print("f $dto->[0]");
    my $tmpnam = "$bdir/drpmsync/wip/$pn";
    if ($dto->[2] =~ /^2/) {
      $ans = tolength(*S, $ans, $anssize);
      $ctx->add(substr($ans, 0, $anssize));
      symlink(substr($ans, 0, $anssize), $tmpnam) || die("symlink: $!\n");
      $ans = substr($ans, $anssize);
    } else {
      $ans = copytofile(*S, $tmpnam, $ans, $anssize, $ctx);
    }
    $ans = checknetmd5(*S, $ans, $ctx);
    fixmodetime($tmpnam, substr($extra, 0, 12)) if $dto->[2] !~ /^2/;
    my @s = lstat($tmpnam);
    die("$tmpnam: $!\n") unless @s;
    if ($dto->[2] =~ /^2/) {
      $files{$dto->[0]} = [ $dto->[0], "$s[9]/$s[7]/$s[1]", sprintf("2%03x%08x", ($s[2] & 07777), $s[9]), linkinfo($tmpnam) ];
    } else {
      $files{$dto->[0]} = [ $dto->[0], "$s[9]/$s[7]/$s[1]", sprintf("1%03x%08x", ($s[2] & 07777), $s[9]), fileinfo($tmpnam) ];
    }
    rename($tmpnam, "$bdir/$dto->[0]") || die("rename $tmpnam $bdir/$dto->[0]: $!\n");
  } elsif ($type eq 'RPM ') {
    $sabytes -= $anssize;
    my $tmpnam;
    die("more than one rpm?\n") if $nrpm > 1;
    die("nothing to do?\n") if $nrpm == 0 && $ndrpm == 0;
    my @deltas;
    my $dextra = substr($extra, 12 + 16);
    if ($nrpm == 0) {
      if ($ndrpm == 1 && substr($dextra, 12, 32) eq substr($dextra, 12 + 64, 32)) {
	recvlog_print("s $dto->[0]");
      } else {
	recvlog_print("d $dto->[0]");
      }
    }
    while ($ndrpm > 0) {
      $tmpnam = "$bdir/drpmsync/wip/".substr($dextra, 12, 32 * 3);
      my $size = hex(substr($dextra, 12 + 3 * 32, 8));
      die("delta rpm bigger than answer? $size > $anssize\n") if $size > $anssize;
      $ans = copytofile(*S, $tmpnam, $ans, $size, $ctx);
      $anssize -= $size;
      fixmodetime($tmpnam, substr($dextra, 0, 12));
      $dextra = substr($dextra, 12 + 32 * 3 + 8);
      push @deltas, $tmpnam;
      $ndrpm--;
    }
    $tmpnam = "$bdir/drpmsync/wip/$pn";
    if ($nrpm == 1) {
      $ans = copytofile(*S, $tmpnam, $ans, $anssize, $ctx);
      $anssize = 0;
      fixmodetime($tmpnam, substr($extra, 0, 12));
      my @s = stat($tmpnam);
      die("$tmpnam: $!\n") unless @s;
      $sabytes += $s[7];
      my $oldd5 = $d ? substr($d->[3], 32) : undef;
      $files{$dto->[0]} = [ $dto->[0], "$s[9]/$s[7]/$s[1]", sprintf("1%03x%08x", ($s[2] & 07777), $s[9]), rpminfo($tmpnam) ];
      if ($oldd5 && !@deltas && $config_generate_deltas) {
        # die("making signature delta?\n") if $oldd5 eq substr($files{$dto->[0]}->[3], 32);
	recvlog_print("m $dto->[0]");
        @deltas = makedelta("$bdir/$d->[0]", $tmpnam, "$bdir/drpmsync/wip/$oldd5$files{$dto->[0]}->[3]");
      } else {
	recvlog_print("r $dto->[0]");
      }
    } else {
      die("need rpm to apply deltas\n") if !$d->[1];
      die("no deltas?") unless @deltas;
      #recvlog("applying deltarpm to $d->[0]");
      @deltas = applydeltas("$bdir/$d->[0]", $tmpnam, @deltas);
      fixmodetime($tmpnam, substr($extra, 0, 12));
      my @s = stat($tmpnam);
      die("$tmpnam: $!\n") unless @s;
      $sabytes += $s[7] - $anssize;
      $files{$dto->[0]} = [ $dto->[0], "$s[9]/$s[7]/$s[1]", sprintf("1%03x%08x", ($s[2] & 07777), $s[9]), rpminfo($tmpnam) ];
    }
    die("junk at end of answer\n") if $anssize;
    $ans = checknetmd5(*S, $ans, $ctx);
    if ($config_keep_deltas && @deltas) {
      my $dpn = $dto->[5];
      mkdir_p("$bdir/drpmsync/deltas/$dpn");
      for my $delta (@deltas) {
	my $dn = $delta;
	$dn =~ s/.*\///;
	if (substr($dn, 0, 32) eq substr($dn, 64, 32)) {
          # print("detected signature-only delta\n");
	  local(*DDIR);
	  opendir(DDIR, "$bdir/drpmsync/deltas/$dpn") || die("opendir $bdir/drpmsync/deltas/$dpn: $!\n");
	  my @dh = grep {$_ =~ /^[0-9a-z]{96}$/} readdir(DDIR);
	  closedir(DDIR);
	  @dh = grep {substr($_, 64, 32) eq substr($dn, 64, 32)} @dh;
	  @dh = grep {substr($_, 32, 32) ne substr($dn, 32, 32)} @dh;
	  for my $dh (@dh) {
	    # recvlog_print("! $dh");
	    my $nn = substr($dh, 0, 32).substr($dn, 32, 64);
	    my @oldstat = stat("$bdir/drpmsync/deltas/$dpn/$dh");
	    die("$bdir/drpmsync/deltas/$dpn/$dh: $!") unless @oldstat;
	    system($combinedeltarpm, "$bdir/drpmsync/deltas/$dpn/$dh", $delta, "$bdir/drpmsync/wip/$nn") && die("combinedeltarpm failed\n");
	    die("combinedeltarpm did not create delta\n") unless -f "$bdir/drpmsync/wip/$nn";
	    utime($oldstat[9], $oldstat[9], "$bdir/drpmsync/wip/$nn");
	    rename("$bdir/drpmsync/wip/$nn", "$bdir/drpmsync/deltas/$dpn/$nn") || die("$bdir/drpmsync/wip/$nn $bdir/drpmsync/deltas/$dpn/$nn: $!\n");
	    unlink("$bdir/drpmsync/deltas/$dpn/$dh") || die("unlink $bdir/drpmsync/deltas/$dpn/$dh: $!\n");
	  }
	  unlink($delta) || die("unlink $delta: $!\n");
	} else {
	  rename($delta, "$bdir/drpmsync/deltas/$dpn/$dn") || die("rename $delta $bdir/drpmsync/deltas/$dn: $!\n");
	}
      }
    } else {
      for my $delta (@deltas) {
        unlink($delta) || die("unlink $delta: $!\n");
      }
    }
    rename($tmpnam, "$bdir/$dto->[0]") || die("rename $tmpnam $bdir/$dto->[0]: $!\n");
  } else {
    die("received strange answer type: $type\n");
  }
  if ($id ne 'DRPMSYNK' || length($ans)) {
    close(S);
    undef $sock_isopen;
  }
}

sub get_syncfiles {
  opensock() unless $sock_isopen;
  print "getting file list...\n";
  my $query = "GET $esyncroot/drpmsync/contents?drpmsync".($have_zlib ? '&zlib' : '')." HTTP/1.0\r\nHost: $synchost\r\n\r\n";
  $txbytes += length($query);
  (syswrite(S, $query, length($query)) || 0) == length($query) || die("network write failed\n");
  my $ans = '';
  do {
    die("received truncated answer\n") if !sysread(S, $ans, 1024, length($ans));
  } while ($ans !~ /\n\r?\n/s);
  $rvbytes += length($ans);
  $ans =~ /\n\r?\n(.*)$/s;
  $rvbytes -= length($1);
  $ans = tolength(*S, $1, 32);
  my $id = substr($ans, 0, 8);
  die("received bad answer\n") if $id ne 'DRPMSYNC' && $id ne 'DRPMSYNK';
  my $vers = hex(substr($ans, 8, 4));
  die("answer has bad version\n") if $vers != 1;
  my $type = substr($ans, 12, 4);
  if ($type eq 'ERR ') {
    my $anssize = hex(substr($ans, 24, 8));
    $ans = tolength(*S, $ans, 32 + $anssize);
    die("remote error: ".substr($ans, 32, $anssize)."\n");
  }
  die("can only sync complete trees\n") if $type eq 'GONE';
  die("server send wrong answer\n") if $type ne 'SYNC' && $type ne 'SYNZ';
  die("server send bad answer\n") if hex(substr($ans, 16, 8));
  my $anssize = hex(substr($ans, 24, 8));
  die("answer is too short\n") if $anssize < 28;
  $rvbytes += 32 + $anssize + 32;
  $ans = substr($ans, 32);
  $ans = tolength(*S, $ans, $anssize);
  my $data = substr($ans, 0, $anssize);
  $ans = substr($ans, $anssize);
  my $ctx = Digest::MD5->new;
  $ctx->add($data);
  $ans = checknetmd5(*S, $ans, $ctx);
  if ($id ne 'DRPMSYNK' || length($ans)) {
    close(S);
    undef $sock_isopen;
  }
  $data = substr($data, 12);
  if ($type eq 'SYNZ') {
    die("cannot uncompress\n") unless $have_zlib;
    $data = Compress::Zlib::uncompress($data);
  }
  my $filesnum = unpack('N', $data);
  # work around perl 5.8.0 bug, where "(w/a*w/a*)*" does not work
  my @data = unpack("x[N]".("w/a*w/a*" x ($filesnum + 1)), $data);
  die("bad tree start\n") if @data < 2 || length($data[1]) != 8;
  die("bad number of file entries\n") if @data != 2 * $filesnum + 2;
  $synctree = shift @data;
  $synctree .= '/' if $synctree ne '/';
  ($newstamp1, $newstamp2) = unpack('H8H8', shift @data);
  my @syncfiles = ();
  while (@data) {
    my ($name, $hex) = splice @data, 0, 2;
    die("bad file name in list: $name\n") if "/$name/" =~ /\/(\.|\.\.|)\//;
    if (length($hex) == 6) {
      push @syncfiles, [ $name, undef, unpack('H12', $hex) ];
    } elsif (length($hex) == 6 + 16) {
      push @syncfiles, [ $name, undef, unpack('H12H32', $hex) ];
    } elsif (length($hex) >= 6 + 32 + 4) {
      my @l = ($name, undef, unpack('H12H64H8a*', $hex));
      die("bad name.arch in file list: $l[5]\n") if $l[5] eq '.' || $l[5] eq '..' || $l[5] =~ /\//;
      push @syncfiles, \@l;
    } else {
      die("bad line for $name\n");
    }
  }
  return @syncfiles;
}

sub send_fin {
  opensock() unless $sock_isopen;
  my $query = "GET $esyncroot/drpmsync/closesock?drpmsync HTTP/1.0\r\nHost: $synchost\r\n\r\n";
  $txbytes += length($query);
  syswrite(S, $query, length($query)) == length($query) || die("network write failed\n");
  close(S);
  undef $sock_isopen;
}

sub fixmodetime {
  my ($fn, $mthex) = @_;
  my $mode = hex(substr($mthex, 1, 3));
  my $ti = hex(substr($mthex, 4, 8));
  chmod($mode, $fn) == 1 || die("chmod: $!\n");
  utime($ti, $ti, $fn) == 1 || die("utime: $!\n");
}

my $cmdline_cf;
my $cmdline_source;

if (@ARGV > 2 && $ARGV[0] eq '-c') {
  shift @ARGV;
  $cmdline_cf = shift @ARGV;
}
if (@ARGV == 2 && $ARGV[0] !~ /^-/) {
  $cmdline_source = shift @ARGV;
}
die("Usage: drpmsync [-c config] [source] <dir> | -s <serverconfig>\n") if @ARGV != 1;
my $basedir = $ARGV[0];
if (-f $basedir) {
  die("$basedir: not a directory (did you forget -s?)\n");
}
if (defined($cmdline_cf) || !defined($cmdline_source) || (-e "$basedir/drpmsync/config")) {
  readconfig_client(defined($cmdline_cf) ? $cmdline_cf : "$basedir/drpmsync/config");
}
@config_source = $cmdline_source if defined $cmdline_source;

# get the lock

mkdir_p("$basedir/drpmsync");
sysopen(LOCK, "$basedir/drpmsync/lock", POSIX::O_RDWR|POSIX::O_CREAT, 0666) || die("$basedir/drpmsync/lock: $!\n");
if (!flock(LOCK, LOCK_EX | LOCK_NB)) {
  my $lockuser = '';
  sysread(LOCK, $lockuser, 1024);
  close LOCK;
  $lockuser = "somebody else\n" unless $lockuser =~ /.*[\S].*\n$/s;
  print "update already in progress by $lockuser";
  exit(1);
}
truncate(LOCK, 0);
syswrite(LOCK, "drpmsync[$$]\@$synchost\n");

my ($oldstamp1, $oldstamp2);
if (open(STAMP, "<$basedir/drpmsync/timestamp")) {
  my $s = '';
  if ((sysread(STAMP, $s, 16) || 0) == 16 && $s !~ /[^0-9a-z]/) {
    $oldstamp1 = substr($s, 0, 8);
    $oldstamp2 = substr($s, 8, 8);
  }
  close STAMP;
}
$oldstamp1 ||= "00000000";

mkdir_p("$basedir/drpmsync/wip");

# clear the wip
if (opendir(WIP, "$basedir/drpmsync/wip")) {
  for (readdir(WIP)) {
    next if $_ eq '.' || $_ eq '..';
    unlink("$basedir/drpmsync/wip/$_") || die("unlink $basedir/drpmsync/wip/$_: $!\n");
  }
  closedir(WIP);
}

readcache("$basedir/drpmsync/cache");
print "getting state of local tree...\n";
findfiles($basedir, '');
print("cache:  $cachehits hits, $cachemisses misses\n");
writecache("$basedir/drpmsync/cache");

if (!@config_source) {
  unlink("$basedir/drpmsync/lock");
  close(LOCK);
  exit(0);
}

my @syncfiles;
my %syncfiles;

if (@config_source) {
  my %errors;
  for my $s (@config_source) {
    $syncurl = $s;
    ($syncaddr, $syncport, $syncroot) = $s =~ /^([^\/]+?)(?::(\d+))?(\/.*)$/;
    if (!$syncaddr) {
      $errors{$s} = "bad url";
      next;
    }
    $esyncroot = aescape($syncroot);
    $syncport ||= 80;
    $syncaddr = inet_aton($syncaddr);
    if (!$syncaddr) {
      $errors{$s} = "could not resolv host";
      next;
    }
    print "trying $s\n";
    eval {
      @syncfiles = get_syncfiles();
    };
    last unless $@;
    $errors{$s} = "$@";
    $errors{$s} =~ s/\n$//s;
    undef $syncaddr;
  }
  if (!$syncaddr) {
    if (@config_source == 1) {
      die("could not connect to $config_source[0]: $errors{$config_source[0]}\n");
    } else {
      print STDERR "could not connect to any server:\n";
      print STDERR "  $_: $errors{$_}\n" for @config_source;
      exit(1);
    }
  }
}

$config_recvlog = "$basedir/drpmsync/$config_recvlog" if $config_recvlog && $config_recvlog !~ /^\//;
if ($config_recvlog) {
  open(RECVLOG, ">>$config_recvlog") || die("$config_recvlog: $!\n");
  select(RECVLOG);
  $| = 1;
  select(STDOUT);
  recvlog("started update from $syncurl");
}

if ($oldstamp1 ne '00000000' && $oldstamp1 gt $newstamp1) {
  if ($newstamp1 eq '00000000') {
    die("remote tree is incomplete\n");
  }
  die("remote tree is older than local tree (last completion): ".toiso(hex($newstamp1))." < ".toiso(hex($oldstamp1))."\n");
}
if ($oldstamp2 && $oldstamp2 gt $newstamp2) {
  die("remote tree is older than local tree (last start): ".toiso(hex($newstamp2))." < ".toiso(hex($oldstamp2))."\n");
}
open(STAMP, ">$basedir/drpmsync/timestamp.new") || die("$basedir/drpmsync/timestamp.new: $!\n");
print STAMP "$oldstamp1$newstamp2\n";
close STAMP;
rename("$basedir/drpmsync/timestamp.new", "$basedir/drpmsync/timestamp");

# change all directories to at least user rwx
for (@syncfiles) {
  next if $_->[2] !~ /^0/;
  next if (hex(substr($_->[2], 0, 4)) & 0700) == 0700;
  $_->[2] = sprintf("0%03x", hex(substr($_->[2], 0, 4)) | 0700).substr($_->[2], 4);
}

printf "local:  ".@files." entries\n";
printf "remote: ".@syncfiles." entries\n";

%files = map {$_->[0] => $_} @files;
%syncfiles = map {$_->[0] => $_} @syncfiles;

# 1) create all new directories
# 2) delete all dirs that are now files
# 3) get all rpms and update/delete the associated files
# 4) update all other files
# 5) delete all files/rpms/directories
# 6) set mode/time of directories

# part 1
for my $dir (grep {@$_ == 3} @syncfiles) {
  my $d = $files{$dir->[0]};
  if ($d) {
    next if $d->[2] =~ /^0/;
    recvlog_print("- $d->[0]");
    unlink("$basedir/$d->[0]") || die("unlink $basedir/$d->[0]: $!\n");
  }
  recvlog_print("+ $dir->[0]");
  mkdir("$basedir/$dir->[0]", 0755) || die("mkdir $basedir/$dir->[0]: $!\n");
  fixmodetime("$basedir/$dir->[0]", $dir->[2]);
  my @s = lstat("$basedir/$dir->[0]");
  die("$basedir/$dir->[0]: $!\n") unless @s;
  $files{$dir->[0]} = [ $dir->[0], "$s[9]/$s[7]/$s[1]", sprintf("0%03x%08x", ($s[2] & 07777), $s[9]) ];
  dirchanged($dir->[0]);
}

# part 2
@files = sort {$a->[0] cmp $b->[0]} values %files;
for my $dir (grep {@$_ == 3} @files) {
  my $sd = $syncfiles{$dir->[0]};
  next if !$sd || $sd->[2] =~ /^0/;
  next unless $files{$dir->[0]};
  my @subf = grep {$_->[0] =~ /^\Q$dir->[0]\E\//} @files;
  unshift @subf, $dir;
  @subf = reverse @subf;
  for my $subf (@subf) {
    recvlog_print("- $subf->[0]");
    if ($subf->[2] =~ /^0/) {
      rmdir("$basedir/$subf->[0]") || die("rmdir $basedir/$subf->[0]: $!\n");
    } else {
      unlink("$basedir/$subf->[0]") || die("unlink $basedir/$subf->[0]: $!\n");
    }
    delete $files{$subf->[0]};
  }
  dirchanged($dir->[0]);
  @files = sort {$a->[0] cmp $b->[0]} values %files;
}

# part 3
my @syncrpms = grep {@$_ > 4} @syncfiles;
# sort by rpm built date
@syncrpms = sort {$a->[4] cmp $b->[4]} @syncrpms;
for my $rpm (@syncrpms) {
  update($basedir, $rpm);
  # update meta file(s)
  my $rpmname = $rpm->[0];
  $rpmname =~ s/\.[sr]pm$//;
  for my $afn ("$rpmname.changes", "$rpmname-MD5SUMS.meta", "$rpmname-MD5SUMS.srcdir") {
    my $sd = $syncfiles{$afn};
    my $d = $files{$afn};
    next if !$d && !$sd;
    if ($d && !$sd) {
      next if $d->[2] =~ /^0/;
      recvlog_print("- $d->[0]");
      unlink("$basedir/$d->[0]") || die("unlink $basedir/$d->[0]: $!\n");
      dirchanged($d->[0]);
      delete $files{$d->[0]};
    } else {
      update($basedir, $sd);
    }
  }
}

# part 4
for my $file (grep {@$_ == 4} @syncfiles) {
  update($basedir, $file);
}

send_fin() if $sock_isopen;

# part 5
@files = sort {$a->[0] cmp $b->[0]} values %files;
for my $file (grep {!$syncfiles{$_->[0]}} reverse @files) {
  recvlog_print("- $file->[0]");
  if ($file->[2] =~ /^0/) {
    rmdir("$basedir/$file->[0]") || die("rmdir $basedir/$file->[0]: $!\n");
  } else {
    unlink("$basedir/$file->[0]") || die("unlink $basedir/$file->[0]: $!\n");
  }
  dirchanged($file->[0]);
  delete $files{$file->[0]};
}

# part 6
for my $dir (grep {@$_ == 3} @syncfiles) {
  my $d = $files{$dir->[0]};
  next if !$d || $d->[2] eq $dir->[2];
  fixmodetime("$basedir/$dir->[0]", $dir->[2]);
}

@files = sort {$a->[0] cmp $b->[0]} values %files;
writecache("$basedir/drpmsync/cache");
open(STAMP, ">$basedir/drpmsync/timestamp.new") || die("$basedir/drpmsync/timestamp.new: $!\n");
print STAMP "$newstamp1$newstamp2\n";
close STAMP;
rename("$basedir/drpmsync/timestamp.new", "$basedir/drpmsync/timestamp");
if (defined($config_delta_max_age)) {
  print "removing outdated deltas...\n";
  my $nold = 0;
  my $cut = time() - 24*60*60*$config_delta_max_age;
  if (opendir(PACKS, "$basedir/drpmsync/deltas")) {
    my @packs = readdir(PACKS);
    closedir(PACKS);
    for my $pack (@packs) {
      next if $pack eq '.' || $pack eq '..';
      next unless opendir(DELTAS, "$basedir/drpmsync/deltas/$pack");
      my @deltas = readdir(DELTAS);
      closedir(DELTAS);
      for my $delta (@deltas) {
	next if $delta eq '.' || $delta eq '..';
        my @s = stat "$basedir/drpmsync/deltas/$pack/$delta";
        next unless @s;
        next if $s[9] >= $cut;
        unlink("$basedir/drpmsync/deltas/$pack/$delta") || die("unlink $basedir/drpmsync/deltas/$pack/$delta: $!\n");
	$nold++;
      }
    }
  }
  recvlog_print("removed $nold deltarpms") if $nold;
}
recvlog("update finished $txbytes/$rvbytes/$sabytes");
close(RECVLOG) if $config_recvlog;
unlink("$basedir/drpmsync/lock");
close(LOCK);
if ($sabytes == 0) {
  printf "update finished, sent %.1f K, received %.1f M\n", $txbytes / 1000, $rvbytes / 1000000;
} elsif ($sabytes < 0) {
  printf "update finished, sent %.1f K, received %.1f M, deltarpm excess %.1f M\n", $txbytes / 1000, $rvbytes / 1000000, (-$sabytes) /1000000;
} else {
  printf "update finished, sent %.1f K, received %.1f M, deltarpm savings %.1f M\n", $txbytes / 1000, $rvbytes / 1000000, $sabytes /1000000;
}
