#!/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;
my $have_time_hires;
eval {
  require Compress::Zlib;
  $have_zlib = 1;
};
eval {
  require Time::HiRes;
  $have_time_hires = 1 if defined &Time::HiRes::gettimeofday;
};
use strict;

$SIG{'PIPE'} = 'IGNORE';

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

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

sub stdinopen {
  local *F = shift;
  local *I = shift;
  my $pid;
  while (1) {
    $pid = open(F, '-|');
    last if defined $pid;
    return if $! != POSIX::EAGAIN;
    sleep(5);
  }
  return 1 if $pid;
  if (fileno(I) != 0) {
    open(STDIN, "<&I") || die("dup stdin: $!\n");
    close(I);
  }
  exec @_;
  die("$_[0]: $!\n");
}

sub tmpopen {
  local *F = shift;
  my $tmpdir = shift;

  my $tries = 0;
  for ($tries = 0; $tries < 100; $tries++) {
    if (sysopen(F, "$tmpdir/drpmsync.$$.$tries", POSIX::O_RDWR|POSIX::O_CREAT|POSIX::O_EXCL, 0600)) {
      unlink("$tmpdir/drpmsync.$$.$tries");
      return 1;
    }
  }
  return;
}

# cannot use IPC::Open3, sigh...
sub runprg {
  return runprg_job(undef, @_);
}

sub runprg_job {
  my ($job, $if, $of, @prg) = @_;
  local (*O, *OW, *E, *EW);
  if (!$of) {
    pipe(O, OW) || die("pipe: $!\n");
  }
  pipe(E, EW) || die("pipe: $!\n");
  my $pid;
  while (1) {
    $pid = fork();
    last if defined $pid;
    return ('', "runprg: fork: $!") if $! != POSIX::EAGAIN;
    sleep(5);
  }
  if ($pid == 0) {
    if ($of) {
      *OW = $of;
    } else {
      close(O);
    }
    close(E);
    if (fileno(OW) != 1) {
      open(STDOUT, ">&OW") || die("dup stdout: $!\n");
      close(OW);
    }
    if (fileno(EW) != 2) {
      open(STDERR, ">&EW") || die("dup stderr: $!\n");
      close(EW);
    }
    if (defined($if)) {
      local (*I) = $if;
      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) unless $of;
  close(EW);

  if ($job) {
    $job->{'PID'} = $pid;
    $job->{'E'} = *E;
    delete $job->{'O'};
    $job->{'O'} = *O unless $of;
    return $job;
  }
  $job = {};
  $job->{'PID'} = $pid;
  $job->{'E'} = *E;
  $job->{'O'} = *O unless $of;
  return runprg_finish($job);
}

sub runprg_finish {
  my ($job) = @_;

  die("runprg_finish: no job running\n") unless $job && $job->{'PID'};
  my ($out, $err) = ('', '');
  my $pid = $job->{'PID'};
  local *E = $job->{'E'};
  local *O;
  my $of = 1;
  if (exists $job->{'O'}) {
    $of = undef;
    *O = $job->{'O'};
  }
  delete $job->{'PID'};
  delete $job->{'O'};
  delete $job->{'E'};
  my $rin = '';
  my $efd = fileno(E);
  my $ofd;
  if (!$of) {
    $ofd = fileno(O);
    vec($rin, $ofd, 1) = 1;
  }
  vec($rin, $efd, 1) = 1;
  my $nfound;
  my $rout;
  my $openfds = $of ? 2 : 3;
  while ($openfds) {
    $nfound = select($rout = $rin, undef, undef, undef);
    if (!defined($nfound)) {
      $err .= "select: $!";
      close(O) if $openfds & 1;
      close(E) if $openfds & 2;
      last;
    }
    if (!$of && 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;
      }
    }
  }
  while(1) {
    if (waitpid($pid, 0) == $pid) {
      $err = "Error $?" if $? && $err eq '';
      last;
    }
    if ($! != POSIX::EINTR) {
      $err = "waitpid: $!";
      last;
    }
  }
  return ($out, $err);
}

sub cprpm {
  local *F = shift;
  my ($wri, $verify, $ml) = @_;

  local *WF;
  *WF = $wri if $wri;

  my $ctx;
  $ctx = Digest::MD5->new if $verify;

  my $buf = '';
  my $l;
  while (length($buf) < 96 + 16) {
    $l = sysread(F, $buf, defined($ml) && $ml < 4096 ? $ml : 4096, length($buf));
    return "read error" unless $l;
    $ml -= $l if defined $ml;
  }
  my ($magic, $sigtype) = unpack('N@78n', $buf);
  return "not a rpm (bad magic of header type" unless $magic == 0xedabeedb && $sigtype == 5;
  my ($headmagic, $cnt, $cntdata) = unpack('@96N@104NN', $buf);
  return "not a rpm (bad sig header magic)" unless $headmagic == 0x8eade801;
  my $hlen = 96 + 16 + $cnt * 16 + $cntdata;
  $hlen = ($hlen + 7) & ~7;
  while (length($buf) < $hlen) {
    $l = sysread(F, $buf, defined($ml) && $ml < 4096 ? $ml : 4096, length($buf));
    return "read error" unless $l;
    $ml -= $l if defined $ml;
  }
  my $lmd5 = Digest::MD5::md5_hex(substr($buf, 0, $hlen));
  my $idxarea = substr($buf, 96 + 16, $cnt * 16);
  if (!($idxarea =~ /\A(?:.{16})*\000\000\003\354\000\000\000\007(....)\000\000\000\020/s)) {
     return "no md5 signature header";
  }
  my $md5off = unpack('N', $1);
  return "bad md5 offset" if $md5off >= $cntdata;
  $md5off += 96 + 16 + $cnt * 16;
  my $hmd5 = unpack("\@${md5off}H32", $buf);
  return "write error" if $wri && (syswrite(WF, substr($buf, 0, $hlen)) || 0) != $hlen;
  $buf = substr($buf, $hlen);
  while (length($buf) < 16) {
    $l = sysread(F, $buf, defined($ml) && $ml < 4096 ? $ml : 4096, length($buf));
    return "read error" unless $l;
    $ml -= $l if defined $ml;
  }
  ($headmagic, $cnt, $cntdata) = unpack('N@8NN', $buf);
  return "not a rpm (bad header magic)" unless $headmagic == 0x8eade801;
  $hlen = 16 + $cnt * 16;
  while (length($buf) < $hlen) {
    $l = sysread(F, $buf, defined($ml) && $ml < 4096 ? $ml : 4096, length($buf));
    return "read error" unless $l;
    $ml -= $l if defined $ml;
  }
  my ($nameoff, $archoff, $btoff);
  $idxarea = substr($buf, 0, $hlen);
  my $srctype = '';
  if (!($idxarea =~ /\A(?:.{16})*\000\000\004\024/s)) {
    if (($idxarea =~ /\A(?:.{16})*\000\000\004[\033\034]/s)) {
      $srctype = 'nosrc';
    } else {
      $srctype = 'src';
    }
  }
  if (($idxarea =~ /\A(?:.{16})*\000\000\003\350\000\000\000\006(....)\000\000\000\001/s)) {
    $nameoff = unpack('N', $1);
  }
  if (($idxarea =~ /\A(?:.{16})*\000\000\003\376\000\000\000\006(....)\000\000\000\001/s)) {
    $archoff = unpack('N', $1);
  }
  if (($idxarea =~ /\A(?:.{16})*\000\000\003\356\000\000\000\004(....)\000\000\000\001/s)) {
    $btoff = unpack('N', $1);
  }
  return "rpm contains no name tag" unless defined $nameoff;
  return "rpm contains no arch tag" unless defined $archoff;
  return "rpm contains no build time" unless defined $btoff;
  return "bad name/arch offset" if $nameoff >= $cntdata || $archoff >= $cntdata || $btoff + 3 >= $cntdata;
  $ctx->add(substr($buf, 0, $hlen)) if $verify;
  return "write error" if $wri && (syswrite(WF, substr($buf, 0, $hlen)) || 0) != $hlen;
  $buf = substr($buf, $hlen);
  my $maxoff = $nameoff > $archoff ? $nameoff : $archoff;
  $maxoff += 1024;	# should be enough
  $maxoff = $btoff + 4 if $btoff + 4 > $maxoff;
  $maxoff = $cntdata if $maxoff > $cntdata;
  while (length($buf) < $maxoff) {
    $l = sysread(F, $buf, defined($ml) && $ml < 4096 ? $ml : 4096, length($buf));
    return "read error" unless $l;
    $ml -= $l if defined $ml;
  }
  my $name = unpack("\@${nameoff}Z*", $buf);
  my $arch = unpack("\@${archoff}Z*", $buf);
  my $bt = unpack("\@${btoff}H8", $buf);
  if ($verify || $wri) {
    $ctx->add($buf) if $verify;
    return "write error" if $wri && (syswrite(WF, $buf) || 0) != length($buf);
    while(1) {
      last if defined($ml) && $ml == 0;
      $l = sysread(F, $buf, defined($ml) && $ml < 8192 ? $ml : 8192);
      last if !$l && !defined($ml);
      return "read error" unless $l;
      $ml -= $l if defined $ml;
      $ctx->add($buf) if $verify;
      return "write error" if $wri && (syswrite(WF, $buf) || 0) != $l;
    }
    if ($verify) {
      my $rmd5 = $ctx->hexdigest;
      return "rpm checksum error ($rmd5 != $hmd5)" if $rmd5 ne $hmd5;
    }
  }
  $name = "unknown" if $name =~ /[\000-\040\/]/;
  $arch = "unknown" if $arch =~ /[\000-\040\/]/;
  $arch = $srctype if $srctype;
  return ("$lmd5$hmd5", $bt, "$name.$arch");
}

sub cpfile {
  local *F = shift;
  my ($wri) = @_;

  local *WF;
  *WF = $wri if $wri;
  my $ctx;
  $ctx = Digest::MD5->new;
  my ($buf, $l);
  while(1) {
    $l = sysread(F, $buf, 8192);
    last if !$l;
    die("cpfile read error\n") unless $l;
    $ctx->add($buf);
    die("cpfile write error\n") if $wri && (syswrite(WF, $buf) || 0) != $l;
  }
  return ($ctx->hexdigest);
}

sub rpminfo_f {
  my ($fd, $rpm) = @_;
  my @info = cprpm($fd);
  if (@info == 1) {
    warn("$rpm: $info[0]\n");
    return ();
  }
  return @info;
}

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 ();
  }
  return Digest::MD5::md5_hex($fnc);
}

my @filter_comp;
my @filter_arch_comp;

sub run_filter {
  my @x = @_;

  my @f = @filter_comp;
  my @r;
  while (@f) {
    my ($ft, $fre) = splice(@f, 0, 3);
    my @xx = grep {/$fre/} @x;
    my %xx = map {$_ => 1} @xx;
    push @r, @xx if $ft;
    @x = grep {!$xx{$_}} @x;
  }
  return (@r, @x);
}

sub run_filter_one {
  my ($n) = @_;
  my @f = @filter_comp;
  while (@f) {
    my ($ft, $fre) = splice(@f, 0, 3);
    if ($ft) {
      return 1 if $n =~ /$fre/;
    } else {
      return if $n =~ /$fre/;
    }
  }
  return 1;
}

sub compile_filter {
  my @rules = @_;

  my @comp = ();
  for my $rule (@rules) {
    die("bad filter type, must be '+' or '-'\n") unless $rule =~ /^([+-])(.*)$/;
    my $type = $1 eq '+' ? 1 : 0;
    my $match = $2;
    my $anchored = $match =~ s/^\///;
    my @match = split(/\[(\^?.(?:\\.|[^]])*)\]/, $match, -1);
    my $i = 0;
    for (@match) {
      $i = 1 - $i;
      if (!$i) {
	s/([^-\^a-zA-Z0-9])/\\$1/g;
	s/\\\\(\\[]\\\]]|-)/"\\".substr($1, -1)/ge;
	$_ = "[$_]";
	next;
      }
      $_ = "\Q$_\E";
      s/\\\*\\\*/.*/g;
      s/\\\*/[^\/]*/g;
      s/\\\?/[^\/]/g;
    }
    $match = join('', @match);
    if ($anchored) {
      $match = "^$match";
    } else {
      $match = "(?:^|\/)$match";
    }
    $match .= '\/?' if $match !~ /\/$/;
    $match .= '$';
    eval {
      push @comp, $type, qr/$match/s, $rule;
    };
    die("bad filter rule: $rule\n") if $@;
  }
  return @comp;
}

sub filelist_apply_filter {
  my ($flp) = @_;
  return unless @filter_comp;
  my @ns = ();
  my $x;
  for my $e (@$flp) {
    if (defined($x)) {
      next if substr($e->[0], 0, length($x)) eq $x;
      undef $x;
    }
    if (@$e == 3) {
      if (!run_filter_one("$e->[0]/")) {
        $x = "$e->[0]/";
	next;
      }
    } else {
      next if !run_filter_one("$e->[0]");
    }
    push @ns, $e;
  }
  @$flp = @ns;
}

sub filelist_apply_filter_arch {
  my ($flp) = @_;
  return unless @filter_arch_comp;
  my %filtered;
  my @filter_comp_save = @filter_comp;
  @filter_comp = @filter_arch_comp;
  my @ns = ();
  for my $e (@$flp) {
    if (@$e > 5 && !run_filter_one((split('\.', $e->[5]))[-1])) {
      if ($e->[0] =~ /(.*)\.rpm$/) {
        $filtered{"$1.changes"} = 1;
        $filtered{"$1-MD5SUMS.meta"} = 1;
        $filtered{"$1-MD5SUMS.srcdir"} = 1;
      }
      next;
    }
    push @ns, $e;
  }
  @filter_comp = @filter_comp_save;
  @$flp = @ns;
  if (%filtered) {
    # second pass to remove meta files
    @ns = ();
    for my $e (@$flp) {
      next if @$e == 4 && $filtered{$e->[0]};
      push @ns, $e;
    }
    @$flp = @ns;
  }
}

sub filelist_exclude_drpmsync {
  my ($flp) = @_;
  @$flp = grep {$_->[0] =~ /(?:^|\/)drpmsync\//s || (@$_ == 3 && $_->[0] =~ /(?:^|\/)drpmsync$/s)} @$flp;
}

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

sub findfiles {
  my ($bdir, $dir, $keepdrpmdir, $norecurse) = @_;

  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 '';
  if ($dir ne '' && grep {$_ eq 'drpmsync'} @ents) {
    readcache("$bdir${dir}drpmsync/cache") if -f "$bdir${dir}drpmsync/cache";
  }
  my %fents;
  if (@filter_comp) {
    @ents = grep {$_ ne '.' && $_ ne '..'} @ents;
    my @fents = run_filter(map {"$dir$_"} @ents);
    if (@fents != @ents) {
      %fents = map {("$dir$_" => 1)} @ents;
      delete $fents{$_} for @fents;
    }
  }
  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 $ent eq 'drpmsync' && ($dir eq '' || !$keepdrpmdir);
      next if @filter_comp && !run_filter_one("$dir$ent/");
      push @files, [ "$dir$ent", @data ];
      next if $norecurse;
      findfiles($bdir, "$dir$ent", $keepdrpmdir);
    } else {
      next if @filter_comp && $fents{"$dir$ent"};
      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 (@$_ > 5) {
      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 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;
my $servertmp = '/var/tmp';
my $serverpidfile;

sub readconfig_server {
  my $cf = shift;

  my @allow;
  my @deny;
  my $no_combine;
  my $log;
  my $slog;
  my $deltadirs;
  my $maxdeltasize;
  my $maxdeltasizeabs;
  my @denymsg;
  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(' ', $_);
    my $s0 = lc($s[0]);
    $s0 =~ s/:$//;
    my $s1 = @s > 1 ? $s[1] : undef;
    shift @s;
    if ($s0 eq 'allow' || $s0 eq 'deny') {
      for (@s) {
	if (/^\/(.*)\/$/) {
	  $_ = $1;
	  eval { local $::SIG{'__DIE__'}; "" =~ /^$_$/; };
	  die("$s0: bad regexp: $_\n") if $@;
	} else {
	  s/([^a-zA-Z0-9*])/\\$1/g;
	  s/\*/.*/g;
	}
      }
      if ($s0 eq 'allow') {
	@allow = @s;
      } else {
	@deny = @s;
      }
    } elsif ($s0 eq 'denymsg') {
      if (!@s) {
        @denymsg = ();
	next;
      }
      if ($s1 =~ /^\/(.*)\/$/) {
	$s1 = $1;
	eval { local $::SIG{'__DIE__'}; "" =~ /^$s1$/; };
	die("$s0: bad regexp: $s1\n") if $@;
      } else {
	$s1 =~ s/([^a-zA-Z0-9*])/\\$1/g;
	$s1 =~ s/\*/.*/g;
      }
      shift @s;
      push @denymsg, [ $s1, join(' ', @s) ];
    } elsif ($s0 eq 'no_combine') {
      $no_combine = ($s1 && $s1 =~ /true/i);
    } elsif ($s0 eq 'log') {
      $log = $s1;
    } elsif ($s0 eq 'serverlog') {
      $slog = $s1;
    } elsif ($s0 eq 'deltadirs') {
      $deltadirs = $s1;
    } elsif ($s0 eq 'deltarpmpath') {
      my $p = defined($s1) ? "$s1/" : '';
      $makedeltarpm = "${p}makedeltarpm";
      $combinedeltarpm = "${p}combinedeltarpm";
      $fragiso = "${p}fragiso";
    } elsif ($s0 eq 'maxclients') {
      $maxclients = $s1 || 1;
    } elsif ($s0 eq 'servername') {
      $servername = $s1;
    } elsif ($s0 eq 'serveraddr') {
      $serveraddr = $s1;
    } elsif ($s0 eq 'serveruser') {
      $serveruser = $s1;
    } elsif ($s0 eq 'servergroup') {
      $servergroup = $s1;
    } elsif ($s0 eq 'pidfile') {
      $serverpidfile = $s1;
    } elsif ($s0 eq 'maxdeltasize') {
      $maxdeltasize = $s1;
    } elsif ($s0 eq 'maxdeltasizeabs') {
      $maxdeltasizeabs = $s1;
    } elsif ($s0 eq 'tree') {
      die("tree: two arguments required\n") if @s != 2;
      $trees{$s[0]} = { 'allow' => [ @allow ], 
			'deny' => [ @deny ], 
			'denymsg' => [ @denymsg ], 
			'no_combine' => $no_combine,
			'maxdeltasize' => $maxdeltasize,
			'maxdeltasizeabs' => $maxdeltasizeabs,
			'deltadirs' => $deltadirs,
			'log' => $log,
			'root' => $s[1],
			'id' => $s[0]
		      };
    } else {
      die("$cf: unknown configuration parameter: $s0\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;
    die("fork: $!") if $! != POSIX::EAGAIN;
    sleep(5);
  }
  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);
  unlink($serverpidfile) if $serverpidfile;
  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";

  local *SERVERPID;
  if ($serverpidfile) {
    open(SERVERPID, '>', $serverpidfile) || die("$serverpidfile: $!\n");
  }

  if (defined($servergroup)) {
    ($(, $)) = ($servergroup, $servergroup);
    die "setgid: $!\n" if $) != $servergroup;
  }
  if (defined($serveruser)) {
    ($<, $>) = ($serveruser, $serveruser);
    die "setuid: $!\n" if $> != $serveruser;
  }
  serverdetach() unless $nobg;

  if ($serverpidfile) {
    syswrite(SERVERPID, "$$\n");
    close(SERVERPID) || die("$serverpidfile: $!\n");
  }

  fcntl(MS, F_SETFL, 0);
  my $remote_addr;
  while (1) {
    $remote_addr = accept(S, MS) || die "accept: $!\n";
    my $pid;
    while (1) {
      $pid = fork();
      last if defined($pid);
      sleep(5);
    }
    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;
    }
  }
  close MS;
  $standalone = 2;
  setsockopt(S, SOL_SOCKET, SO_KEEPALIVE, pack("l",1));
  $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;
    }
    if ($name eq 'filter' || $name eq 'filter_arch') {
      push @{$cgip->{$name}}, $value;
    } else {
      $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 && length($str) < 16384) {
      my $d;
      my $r = sysread(FF, $d, $flen > 8192 ? 8192 : $flen);
      if (!$r) {
        die("replystream: read error: $!\n") unless defined $r;
        die("replystream: unexpected EOF\n");
      }
      die("replystream: 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("replystream: 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);
  $str = join("\r\n", @hi)."\r\n\r\n$str";
  if (!$standalone) {
    print $str;
    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($str)) {
    $l = syswrite(S, $str, length($str));
    die("write error: $!\n") unless $l;
    $str = substr($str, $l);
  }
}

sub reply_err {
  my ($err, $cgi, $remote_addr) = @_;
  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);
}

my $check_access_cache_addr;
my $check_access_cache_name;

sub check_access {
  my ($tree, $remote_addr) = @_;
  my ($remote_name, $access_ok);

  $remote_name = $check_access_cache_name if $check_access_cache_addr && $check_access_cache_addr eq $remote_addr;

  if (@{$tree->{'deny'}}) {
    if (!$remote_name) {
      $remote_name = gethostbyaddr(inet_aton($remote_addr), AF_INET);
      die("could not resolve $remote_addr\n") unless $remote_name;
      $check_access_cache_addr = $remote_addr;
      $check_access_cache_name = $remote_name;
    }
    for my $deny (@{$tree->{'deny'}}) {
      if ($deny =~ /^!/) {
	my $d1 = substr($deny, 1);
	last if $remote_name =~ /^$d1$/i;
	last if $remote_addr =~ /^$d1$/i;
      }
      goto denied if $remote_name =~ /^$deny$/i;
      goto denied if $remote_addr =~ /^$deny$/i;
    }
  }
  for my $allow (@{$tree->{'allow'}}) {
    last if $allow =~ /^!/;
    return if $remote_addr =~ /^$allow$/i;
  }
  if (!$remote_name) {
    $remote_name = gethostbyaddr(inet_aton($remote_addr), AF_INET);
    die("could not resolve $remote_addr\n") unless $remote_name;
    $check_access_cache_addr = $remote_addr;
    $check_access_cache_name = $remote_name;
  }
  for my $allow (@{$tree->{'allow'}}) {
    if ($allow =~ /^!/) {
      my $a1 = substr($allow, 1);
      last if $remote_name =~ /^$a1$/i;
      last if $remote_addr =~ /^$a1$/i;
    }
    return if $remote_addr =~ /^$allow$/i;
    return if $remote_name =~ /^$allow$/i;
  }
denied:
  my $denymsg = "access denied [%h]";
  for my $dmsg (@{$tree->{'denymsg'}}) {
    if ($remote_name =~ /^$dmsg->[0]$/i || $remote_addr =~ /^$dmsg->[0]$/i) {
      $denymsg = $dmsg->[1];
      last;
    }
  }
  $denymsg =~ s/%h/$remote_addr/g;
  $denymsg =~ s/%n/$remote_name/g;
  die("$denymsg\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 "%05d %04d-%02d-%02d %02d:%02d:%02d %s: %s\n", $$, @lt[5,4,3,2,1,0], $sendlogid, $str;
}

sub solve {
  my ($have2, $info2, @dirs) = @_;

  my @avail;
  for my $dir (@dirs) {
    if (opendir(D, $dir)) {
      push @avail, map {"$dir/$_"} grep {/^[0-9a-f]{96}$/} readdir(D);
      closedir D;
    }
  }
  return () unless @avail;
  my $gotone;
  for (@avail) {
    if ($have2->{substr($_, -96, 32)}) {
      $gotone = 1;
      last;
    }
  }
  return () unless $gotone;
  my @chains = ([$info2]);
  my %avail;
  push @{$avail{substr($_, -32, 32)}}, $_ for @avail;
  while (@chains && @{$chains[0]} <= @avail) {
    for my $pos (splice @chains) {
      for my $a (@{$avail{$pos->[0]}}) {
	my @n = (@$pos, $a);
	$n[0] = substr($a, -96, 32);
	if ($have2->{$n[0]}) {
	  shift @n;
	  return reverse @n;
	}
	push @chains, \@n;
      }
    }
  }
  return ();
}

sub extractrpm {
  local *F = shift;
  my ($o, $l) = @_;
  local *F2;
  tmpopen(*F2, $servertmp);
  defined(sysseek(F, $o, 0)) || die("extractrpm: sysseek: $!\n");
  my $buf;
  while ($l > 0) {
    my $r = sysread(F, $buf, $l > 8192 ? 8192 : $l);
    if (!$r) {
      die("extractrpm: read error: $!\n") unless defined $r;
      die("extractrpm: unexpected EOF\n");
    }
    die("extractrpm: read too much data\n") if $r > $l;
    die("extractrpm: write error: $!\n") if (syswrite(F2, $buf) || 0) != $r;
    $l -= $r;
  }
  close(F);
  seek(F2, 0, 0);
  sysseek(F2, 0, 0);
  open(F, "<&F2") || die("extractrpm: dup: $!\n");
  close(F2);
}

sub hexit {
  my $v = shift;
  if ($v >= 4294967295) {
    my $v2 = int($v / 4294967296);
    return sprintf("FFFFFFFF%02x%08x", $v2, $v - 4294967296 * $v2);
  } else {
    return sprintf("%08x", $v);
  }
}

my $deltadirscache;
my $deltadirscacheid;

sub getdeltadirs {
  my ($ddconfig, $path) = @_;

  my @dirs;
  if ($deltadirscache) {
    my @ddstat = stat($ddconfig);
    undef $deltadirscache if !@ddstat || "$ddstat[9]/$ddstat[7]/$ddstat[1]" ne $deltadirscacheid;
  }
  if (!$deltadirscache) {
    local *DD;
    my @ddc;
    if (open(DD, '<', $ddconfig)) {
      while(<DD>) {
        chomp;
	next if /^\s*$/;
	if (@ddc && /^\s*\+\s*(.*)/) {
	  push @{$ddc[-1]}, split(' ', $1);
	} else {
	  push @ddc, [ split(' ', $_) ];
	}
      }
      my @ddstat = stat(DD);
      close DD;
      $deltadirscache = \@ddc;
      $deltadirscacheid = "$ddstat[9]/$ddstat[7]/$ddstat[1]";
    }
  }
  if ($deltadirscache) {
    for my $dd (@$deltadirscache) {
      my @dd = @$dd;
      my $ddre = shift @dd;
      eval {
        push @dirs, @dd if $path =~ /$ddre/;
      };
    }
  }
  return @dirs;
}

sub serve_request {
  my ($cgi, $path_info, $script_name, $remote_addr, $keep_ok) = @_;

  my $tree;
  $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 = $keep_ok ? '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";
    sendlog("# $croot contents request");
    my $ti = time();
    readcache("$root$croot/drpmsync/cache");
    @files = ();
    $cachehits = $cachemisses = 0;
    @filter_comp = compile_filter(@{$cgi->{'filter'} || []});
    @filter_arch_comp = compile_filter(@{$cgi->{'filter_arch'} || []});
    findfiles("$root$croot", '', 0, exists($cgi->{'norecurse'}) ? 1 : 0);
    filelist_apply_filter_arch(\@files) if @filter_arch_comp;
    %cache = ();
    $ti = time() - $ti;
    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-f]/) {
        $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/$ti)");
      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 > 5) {
        $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);
    }
    @files = ();
    my $dataid = 'SYNC';
    if ($have_zlib && exists($cgi->{'zlib'})) {
      $data = Compress::Zlib::compress($data);
      $dataid = 'SYNZ';
      sendlog("z $croot contents ($cachehits/$cachemisses/$ti)");
    } else {
      sendlog("f $croot contents ($cachehits/$cachemisses/$ti)");
    }
    $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");
    return;
  }

  my @s = lstat("$root$path_info");

  if (!exists($cgi->{'drpmsync'})) {
    die("$spath_info: $!\n") unless @s;
    if (! -d _) {
      die("$spath_info: bad file type\n") unless -f _;
      sendlog("h $path_info");
      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);
    }
    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) {
      @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 (!@s) {
    sendlog("- $path_info");
    my $data = "${replyid}0001GONE".sprintf("%08x", length($spath_info)).'00000000'.$spath_info;
    reply($data, "Content-type: application/octet-stream");
    return;
  }

  if (-d _) {
    # oops, this is bad, the file is now a directory
    # send GONE so it will get removed
    sendlog("X $path_info");
    my $data = "${replyid}0001GONE".sprintf("%08x", length($spath_info)).'00000000'.$spath_info;
    reply($data, "Content-type: application/octet-stream");
    return;
  }

  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");
    return;
  }

  die("$spath_info: bad file type\n") unless -f _;
  open(F, '<', "$root$path_info") || die("$spath_info: $!\n");

  my $extracto = 0;
  my $extractl;

  if ((exists($cgi->{'fiso'}) || exists($cgi->{'extract'})) && ($spath_info =~ /(?<!\.delta)\.iso$/i)) {
    if (!$cgi->{'extract'}) {
      tmpopen(*F2, $servertmp);
      my (undef, $err) = runprg(*F, *F2, $fragiso, 'make', '-', '-');
      die("fragiso make failed: $err\n") if $err;
      close F;
      sysseek(F2, 0, 0);	# currently at EOF
      sendlog("i $path_info");
      my $flen = -s F2;
      my $ctx = Digest::MD5->new;
      my $data = sprintf("1%03x%08x", $s[2] & 07777, $s[9]);
      $ctx->add($data);
      $data = "${replyid}0001FISO".sprintf("%08x", length($spath_info)).hexit(length($data) + $flen).$spath_info.$data;
      replystream(*F2, $flen, $data, $ctx, "Content-type: application/octet-stream");
      close F2;
      return;
    } else {
      die("bad extract: $cgi->{'extract'}\n") unless $cgi->{'extract'} =~ /^([0-9a-fA-F]{2})([0-9a-fA-F]{8}):([0-9a-fA-F]{8})$/;
      # always fits in perl's floats
      $extracto = hex($1) * 4294967296 + hex($2);
      $extractl = hex($3);
      defined(sysseek(F, $extracto, 0)) || die("seek error: $!\n");
      $path_info .= "\@$cgi->{'extract'}";
    }
  } elsif ($spath_info !~ /\.[sr]pm$/) {
    my $flen = $s[7];
    my $data = sprintf("1%03x%08x", $s[2] & 07777, $s[9]);
    if ($s[7] >= 67108864) {
      sendlog("f $path_info");
      my $ctx = Digest::MD5->new;
      $ctx->add($data);
      $data = "${replyid}0001FILE".sprintf("%08x", length($spath_info)).hexit(length($data) + $flen).$spath_info.$data;
      replystream(*F, $flen, $data, $ctx, "Content-type: application/octet-stream");
      return;
    }
    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");
    return;
  }

  my $deltadata = '';
  my $deltaintro = '';
  my $deltanum = 0;
  my $sendrpm = exists($cgi->{'withrpm'}) ? 1 : 0;
  my $key = '';
  if ($cgi->{'have'}) {
    my %have2;
    for (split(',', $cgi->{'havealso'} ? "$cgi->{'have'},$cgi->{'havealso'}" : $cgi->{'have'})) {
      die("bad have parameter\n") if (length($_) != 32 && length($_) != 64) || /[^0-9a-f]/;
      $have2{substr($_, -32, 32)} = 1;
    }
    my @info = rpminfo_f(*F, $spath_info);
    die("$spath_info: bad info\n") unless @info;
    # seek needed because of perl's autoflush when forking
    seek(F, $extracto, 0);
    # only sysread after this!
    defined(sysseek(F, $extracto, 0)) || die("sysseek: $!\n");
    $path_info .= " ($info[2])" if $extracto;
    my $info = $info[0];
    my $info1 = substr($info, 0, 32);
    my $info2 = substr($info, 32, 32);
    if ($have2{$info2}) {
      if ($extracto) {
	# switch to real rpm
        extractrpm(*F, $extracto, $extractl);
	$extracto = 0;
	$extractl = undef;
      }
      # identical payload, create sign only delta
      # sendlog("$path_info: makedeltarpm sign only");
      my ($out, $err) = runprg(*F, undef, $makedeltarpm, '-u', '-r', '-', '-');
      die("makedeltarpm failed: $err\n") if $err;
      $deltaintro .= sprintf("1%03x%08x$info2$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
    } elsif (!exists($cgi->{'nocomplexdelta'})) {
      # ok, lets see if we can build a chain from info2 back to have2
      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 @solution;
      if (length($cgi->{'have'}) == 64 && -f "$deltadir/$cgi->{'have'}$info2") {
	@solution = ("$deltadir/$cgi->{'have'}$info2");
      } else {
        my @deltadirs = ( $deltadir );
        push @deltadirs, map {"$_/$dpn"} getdeltadirs($tree->{'deltadirs'}, $spath_info) if $tree->{'deltadirs'};
        @solution = solve(\%have2, $info2, @deltadirs);
      }
      my $dsize = 0;
      for (@solution) {
	goto lost_delta if ! -e $_;
	die("bad deltarpm: $_\n") if ! -f _;
        if (!exists($cgi->{'uncombined'}) && !$tree->{'no_combine'}) {
          $dsize = -s _ if (-s _) > $dsize;
	} else {
          $dsize += -s _;
	}
      }
      my $maxdeltasize = $cgi->{'maxdeltasize'};
      $maxdeltasize = $tree->{'maxdeltasize'} if defined($tree->{'maxdeltasize'}) && (!defined($maxdeltasize) || $maxdeltasize > $tree->{'maxdeltasize'});
      if (defined($maxdeltasize)) {
	my $flen = -s F;
	$flen = $extractl if defined $extractl;
        @solution = () if $dsize >= ($flen * $maxdeltasize) / 100;
      }
      my $maxdeltasizeabs = $cgi->{'maxdeltasizeabs'};
      $maxdeltasizeabs = $tree->{'maxdeltasizeabs'} if defined($tree->{'maxdeltasizeabs'}) && (!defined($maxdeltasizeabs) || $maxdeltasizeabs > $tree->{'maxdeltasizeabs'});
      @solution = () if defined($maxdeltasizeabs) && $dsize >= $maxdeltasizeabs;
      if (@solution) {
	# sendlog("$path_info: solution @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($combine[0]);
	  goto lost_delta if !@ds || ! -f _;
	  my ($out, $err);
	  if ($dn eq $solution[-1] && substr($dn, -64, 32) ne $info1) {
	    # sendlog("$path_info: combinedeltarpm -S @combine");
	    if ($extracto) {
	      # switch to real rpm
	      extractrpm(*F, $extracto, $extractl);
	      $extracto = 0;
	      $extractl = undef;
	    }
	    ($out, $err) = runprg(*F, undef, $combinedeltarpm, '-S', '-', @combine, '-');
	    defined(sysseek(F, 0, 0)) || die("sysseek: $!\n");
	    substr($combine[-1], -64, 32) = $info1 unless $err;
	    $key .= 's';
	  } elsif (@combine > 1) {
	    # sendlog("$path_info: combinedeltarpm @combine");
	    ($out, $err) = runprg(undef, undef, $combinedeltarpm, @combine, '-');
	  } else {
	    # sendlog("$path_info: readfile @combine");
	    ($out, $err) = readfile($dn);
	  }
	  if ($err) {
	    goto lost_delta if grep {! -f $_} @combine;
	    $err =~ s/\n$//s;
	    sendlog("! $path_info $err");
	    %have2 = ();	# try without deltas
	    goto lost_delta;
	  }
	  $deltaintro .= sprintf("1%03x%08x".substr($combine[0], -96, 32).substr($combine[-1], -64, 64)."%08x", $ds[2] & 07777, $ds[9], length($out));
	  $deltadata .= $out;
	  $deltanum++;
	  @combine = ();
	}
        $key .= $deltanum if $deltanum != 1;
      }
    }
  }
  if (exists($cgi->{'deltaonly'}) && !$deltanum) {
    sendlog("O $path_info");
    my $data = "${replyid}0001NODR".sprintf("%08x", length($spath_info)).'00000000'.$spath_info;
    reply($data, "Content-type: application/octet-stream");
    return;
  }
  $sendrpm = 1 if !$deltanum;
  $key .= 'r' if $sendrpm;
  $key = '?' if $key eq '';
  sendlog("$key $path_info");
  if ($sendrpm) {
    my $flen = -s F;
    $flen = $extractl if defined $extractl;
    if ($flen > 100000 || defined($extractl)) {
      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;
      return;
    }
  }
  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;
  undef $deltadata;
  $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;
  undef $data;
}

if ($::ENV{'REQUEST_METHOD'} || (@ARGV && ($ARGV[0] eq '-s' || $ARGV[0] eq '-S'))) {
  # server mode
  my %cgi;
  my $request_method = $::ENV{'REQUEST_METHOD'};
  if ($request_method) {
    my $query_string = $::ENV{'QUERY_STRING'};
    my $script_name = $::ENV{'SCRIPT_NAME'};
    my $path_info = $::ENV{'PATH_INFO'};
    my $remote_addr = $::ENV{'REMOTE_ADDR'};
    if ($request_method eq 'POST') {
      $query_string = '';
      read(STDIN, $query_string, 0 + $::ENV{'CONTENT_LENGTH'});
    }
    eval {
      parse_cgi(\%cgi, $query_string);
      my $config = $::ENV{'DRPMSYNC_CONFIG'};
      readconfig_server($config);
      serve_request(\%cgi, $path_info, $script_name, $remote_addr, 0);
      exit(0);
    };
    reply_err($@, \%cgi, $remote_addr);
    exit(0);
  }
  my $remote_addr = startserver($ARGV[1], $ARGV[0] eq '-S' ? 1 : 0);
  eval {
    while (1) {
      %cgi = ();
      my ($path, $query_string, $has_via) = getrequest(\%cgi);
      $request_method = 'GET';
      parse_cgi(\%cgi, $query_string);
      my $keep_ok = !$has_via && exists($cgi{'drpmsync'});
      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;
      my $script_name = $mtrees[0]->{'id'};
      my $path_info = substr($path, length($script_name));
      serve_request(\%cgi, $path_info, $script_name, $remote_addr, $keep_ok);
      exit(0) unless $keep_ok;
    }
  };
  reply_err($@, \%cgi, $remote_addr);
  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 $config_repo;
my $config_timeout;
my @config_filter;
my @config_filter_arch;

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

my $newstamp1;
my $newstamp2;

my $runningjob;

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 'timeout:') {
      $config_timeout = @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";
      $fragiso = "${p}fragiso";
    } elsif ($s[0] eq 'log:') {
      $config_recvlog = @s > 1 ? $s[1] : undef;
    } elsif ($s[0] eq 'repo:') {
      $config_repo = @s > 1 ? $s[1] : undef;
    } elsif ($s[0] eq 'exclude:') {
      push @config_filter, map {"-$_"} @s;
    } elsif ($s[0] eq 'include:') {
      push @config_filter, map {"+$_"} @s;
    } elsif ($s[0] eq 'exclude_arch:') {
      push @config_filter_arch, map {"-$_"} @s;
    } elsif ($s[0] eq 'include_arch:') {
      push @config_filter_arch, map {"+$_"} @s;
    } 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 makedelta {
  my ($from, $to, $drpm) = @_;
  # print "makedeltarpm $from $to\n";
  if (substr($drpm, -96, 32) eq substr($drpm, -32, 32)) {
    system($makedeltarpm, @config_generate_delta_compression, '-u', '-r', $to, $drpm) && die("makedeltarpm failed\n");
  } else {
    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 ($job, $from, $to, $extractoff, @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";
    if (system($combinedeltarpm, @deltas, $dn) || ! -s $dn) {
      recvlog_print("! combinedeltarpm @deltas $dn failed");
      unlink @deltas;
      return ();
    }
    utime($d1s[9], $d1s[9], $dn);
  }
  # print "applydeltarpm $from $dn\n";
  my $err;
  if ($extractoff) {
    local *EXTR;
    if (!open(EXTR, '+<', $to)) {
      recvlog_print("! open $to failed: $!");
      unlink(@deltas);
      return ();
    }
    if (!defined(sysseek(EXTR, $extractoff, 0))) {
      recvlog_print("! sysseek $to failed: $!");
      unlink(@deltas);
      return ();
    }
    (undef, $err) = runprg_job($job, undef, *EXTR, $applydeltarpm, '-r', $from, $dn, '-');
    close(EXTR);
  } else {
    (undef, $err) = runprg_job($job, undef, undef, $applydeltarpm, '-r', $from, $dn, $to);
  }
  if ($err) {
    recvlog_print("! applydeltarpm -r $from $dn $to failed: $err");
    unlink(@deltas);
    return ();
  }
  if ($job) {
    $job->{'applydeltas'} = [$from, $dn, $to, @deltas];
    return ($job);
  }
  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);
}

sub applydeltas_finish {
  my ($job) = @_;
  die("job not running\n") unless $job && $job->{'applydeltas'};
  my ($from, $dn, $to, @deltas) = @{$job->{'applydeltas'}};
  delete $job->{'applydeltas'};
  my $err;
  (undef, $err) = runprg_finish($job);
  if ($err) {
    recvlog_print("! applydeltarpm -r $from $dn $to failed: $err");
    unlink(@deltas);
    return ();
  }
  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);
}

sub checkjob {
  my ($pn) = @_;
  return unless $runningjob;
  my $job = $runningjob;
  if (defined($pn)) {
    return if $job->{'wip'} ne $pn;
  }
  undef $runningjob;
  my @args = @{$job->{'finishargs'}};
  delete $job->{'finishargs'};
  $job->{'finish'}->(@args);
}


#######################################################################
# repo functions
#######################################################################

sub repo_search {
  my ($dpn, $k) = @_;
  local *F;
  open(F, '<', "$config_repo/$dpn") || return ();
  my $k2 = substr($k, 32, 32);
  my ($l, @l);
  my (@r1, @r2, @r3);
  while (defined($l = <F>)) {
    chomp $l;
    my @l = split(' ', $l, 3);
    if ($l[0] eq $k) {
      push @r1, \@l;
    } elsif (substr($l[0], 32, 32) eq $k2) {
      push @r2, \@l;
    } else {
      push @r3, \@l;
    }
  }
  close F;
  return (@r1, @r2, @r3);
}

sub repo_check {
  my (@r) = @_;

  my @s;
  for my $r (splice(@r)) {
    if ($r->[2] =~ /^(.*)@([0-9a-f]{10}:[0-9a-f]{8}$)/) {
      @s = stat($1);
    } else {
      @s = stat($r->[2]);
    }
    push @r, $r if @s && $r->[1] eq "$s[9]/$s[7]";
  }
  return @r;
}

sub repo_cp {
  my ($r, $bdir, $to, $extractoff) = @_;

  my $d = "$bdir/$to";

  local(*F, *OF);
  my @s;
  my $len;
  if ($r->[2] =~ /^(.*)@([0-9a-f]{2})([0-9a-f]{8}):([0-9a-f]{8}$)/) {
    my $iso = $1;
    open(F, '<', $iso) || return undef;
    @s = stat(F);
    if (!@s || $r->[1] ne "$s[9]/$s[7]") {
      close F;
      return undef;
    }
    $len = hex($4);
    if (!$len || !defined(sysseek(F, hex($2) * 4294967296 + hex($3), 0))) {
      close F;
      return undef;
    }
  } else {
    open(F, '<', $r->[2]) || return undef;
    @s = stat(F);
    if (!@s || $r->[1] ne "$s[9]/$s[7]") {
      close F;
      return undef;
    }
  }
  if ($extractoff) {
    if (!open(OF, '+<', $d)) {
      close F;
      return undef;
    }
    if (!defined(sysseek(OF, $extractoff, 0))) {
      close F;
      close OF;
      return undef;
    }
  } else {
    if (!open(OF, '>', $d)) {
      close F;
      return undef;
    }
  }
  my @info = cprpm(*F, *OF, 1, $len);
  if (!close(OF)) {
    close(F);
    unlink($d);
    return undef;
  }
  close(F);
  if (@info != 3 || $info[0] ne $r->[0]) {
    unlink($d);
    return undef;
  }
  @s = stat($d);
  if (!@s) {
    unlink($d);
    return undef;
  }
  return [ $to, "$s[9]/$s[7]/$s[1]", sprintf("1%03x%08x", ($s[2] & 07777), $s[9]), @info ];
}

sub repo_add_iso {
  my ($fn, $d) = @_;
  local *F;
  return unless open(F, '-|', $fragiso, 'listiso', $fn);
  my @frags = <F>;
  return unless close(F);
  chomp @frags;
  for my $f (@frags) {
    my @f = split(' ', $f, 3);
    repo_add("$fn\@$f[0]", [ "$fn\@$f[0]", $d->[1], $d->[2], $f[1], undef, $f[2] ] );
  }
}

sub repo_add {
  my ($fn, $d) = @_;

  return if $fn =~ m!drpmsync/wip.*/!;
  if (@$d < 6) {
    repo_add_iso($fn, $d) if $fn =~ /(?<!\.delta)\.iso$/i;
    return;
  }
  return if $fn =~ /[\000-\037]/;
  return if $d->[5] =~ /[\000-\037\/]/ || length($d->[5]) < 3;
  local *OLD;
  local *NEW;
  my $nlid = $d->[1];
  $nlid =~ s/\/[^\/]*$//;
  my $nl;
  $nl = "$d->[3] $nlid $fn" if $nlid;
  my $kill;
  $kill = $1 if $fn =~ /^(.*)@[0-9a-f]{2}[0-9a-f]{8}:[0-9a-f]{8}$/;
  $kill = $fn if !$nlid && $fn =~ /(?<!\.delta)\.iso$/i;
lock_retry:
  if (!sysopen(OLD, "$config_repo/$d->[5]", POSIX::O_RDWR|POSIX::O_CREAT, 0666)) {
    if (!sysopen(OLD, "$config_repo/$d->[5]", POSIX::O_RDONLY)) {
      warn("$config_repo/$d->[5]: $!\n");
      return;
    }
  }
  if (!flock(OLD, LOCK_EX)) {
    warn("$config_repo/$d->[5]: flock: $!\n");
    return;
  }
  if (!(stat(OLD))[3]) {
    close(OLD);
    goto lock_retry;
  }
  my $old = '';
  my $new = '';
  while ((sysread(OLD, $old, 8192, length($old)) || 0) == 8192) {};
  for my $l (split("\n", $old)) {
    if ($nl && $l eq $nl) {
      undef $nl;
    } else {
      if ($kill) {
        my @lf = split(' ', $l);
        next if $lf[2] =~ /^(.*)@[0-9a-f]{2}[0-9a-f]{8}:[0-9a-f]{8}$/ && $kill eq $1 && $lf[1] ne $nlid;
      } else {
        next if (split(' ', $l))[2] eq $fn;
      }
    }
    $new .= "$l\n";
  }
  if ($nl) {
    $new .= "$nl\n";
  } elsif ($old eq $new) {
    close OLD;
    return;
  }
  if (!sysopen(NEW, "$config_repo/$d->[5].new", POSIX::O_WRONLY|POSIX::O_CREAT|POSIX::O_TRUNC, 0666)) {
    warn("$config_repo/$d->[5].new open: $!\n");
    close(OLD);
    return;
  }
  if ((syswrite(NEW, $new) || 0) != length($new) || !close(NEW)) {
    warn("$config_repo/$d->[5].new write: $!\n");
    close(NEW);
    close(OLD);
    unlink("$config_repo/$d->[5].new");
    return;
  }
  if (!rename("$config_repo/$d->[5].new", "$config_repo/$d->[5]")) {
    warn("$config_repo/$d->[5] rename: $!\n");
    close(OLD);
    unlink("$config_repo/$d->[5].new");
    return;
  }
  close(OLD);
}

sub repo_del {
  my ($fn, $d) = @_;
  my $dir;
  if (@$d > 5) {
    $dir = $d->[5];
  } else {
    return if $fn !~ /(?<!\.delta)\.iso$/i;
  }
  if (!$dir) {
    local *DIR;
    opendir(DIR, $config_repo) || return;
    my @ds = grep {$_ ne '.' && $_ ne '..' && !/\..*\.new$/} readdir(DIR);
    closedir(DIR);
    for my $ds (@ds) {
      repo_add($fn, [undef, '', undef, undef, undef, $ds]);
    }
  } else {
    repo_add($fn, [undef, '', undef, undef, undef, $dir]);
  }
}

sub repo_validate {
  my $d = shift;
  if (!$d) {
    local *DIR;
    opendir(DIR, $config_repo) || return;
    my @ds = grep {$_ ne '.' && $_ ne '..' && !/\..*\.new$/} readdir(DIR);
    closedir(DIR);
    for my $ds (@ds) {
      repo_validate($ds);
    }
    return;
  }
  local *OLD;
  local *NEW;
lock_retry:
  if (!sysopen(OLD, "$config_repo/$d", POSIX::O_RDWR|POSIX::O_CREAT, 0666)) {
    if (!sysopen(OLD, "$config_repo/$d", POSIX::O_RDONLY)) {
      warn("$config_repo/$d: $!\n");
      return;
    }
  }
  if (!flock(OLD, LOCK_EX)) {
    warn("$config_repo/$d: flock: $!\n");
    return;
  }
  if (!(stat(OLD))[3]) {
    close(OLD);
    goto lock_retry;
  }
  my $old = '';
  my $new = '';
  while ((sysread(OLD, $old, 8192, length($old)) || 0) == 8192) {};
  for my $l (split("\n", $old)) {
    my @lf = split(' ', $l);
    my @s;
    if ($lf[2] =~ /^(.*)@[0-9a-f]{2}[0-9a-f]{8}:[0-9a-f]{8}$/) {
      @s = stat($1);
    } else {
      @s = stat($lf[2]);
    }
    next if !@s || "$s[9]/$s[7]" ne $lf[1];
    $new .= "$l\n";
  }
  if ($new eq $old) {
    close OLD;
    return;
  }
  if (!sysopen(NEW, "$config_repo/$d.new", POSIX::O_WRONLY|POSIX::O_CREAT|POSIX::O_TRUNC, 0666)) {
    warn("$config_repo/$d.new open: $!\n");
    close(OLD);
    return;
  }
  if ((syswrite(NEW, $new) || 0) != length($new) || !close(NEW)) {
    warn("$config_repo/$d.new write: $!\n");
    close(NEW);
    close(OLD);
    unlink("$config_repo/$d.new");
    return;
  }
  if (!rename("$config_repo/$d.new", "$config_repo/$d")) {
    warn("$config_repo/$d rename: $!\n");
    close(OLD);
    unlink("$config_repo/$d.new");
    return;
  }
  close(OLD);
}

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

my %files;
my %syncfiles;
my $had_gone;

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 $net_start_tv;
my $net_start_rvbytes;
my $net_recv_bytes = 0;
my $net_spent_time = 0;

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

sub setup_proto {
  my $proto = shift;
  if ($proto eq 'file') {
    *get_syncfiles = \&file_get_syncfiles;
    *get_update = \&file_get_update;
    *send_fin = \&file_send_fin;
  } elsif ($proto eq 'drpmsync') {
    *get_syncfiles = \&drpmsync_get_syncfiles;
    *get_update = \&drpmsync_get_update;
    *send_fin = \&drpmsync_send_fin;
  } elsif ($proto eq 'rsync') {
    *get_syncfiles = \&rsync_get_syncfiles;
    *get_update = \&rsync_get_update;
    *send_fin = \&rsync_send_fin;
  } elsif ($proto eq 'null') {
    *get_syncfiles = sub {return ()};
    *get_update = sub {die;};
    *send_fin = sub {};
  } else {
    die("unsupported protocol: $proto\n");
  }
}

#######################################################################
# file protocol
#######################################################################

sub file_get_syncfiles {
  my $norecurse = shift;

  my @oldfiles = @files;
  my @oldcache = %cache;
  my $oldcachehits = $cachehits;
  my $oldcachemisses = $cachemisses;
  @files = ();
  $cachehits = $cachemisses = 0;
  readcache("$syncroot/drpmsync/cache");
  findfiles($syncroot, '', 0, $norecurse);
  my @syncfiles = @files;
  @files = @oldfiles;
  %cache = @oldcache;
  $cachehits = $oldcachehits;
  $cachemisses = $oldcachemisses;
  $newstamp1 = $newstamp2 = sprintf("%08x", time);
  return @syncfiles;
}

sub file_get_update {
  my ($dto, $tmpnam, $reqext, $rextract) = @_;

  die("rextract in FILE transport\n") if $rextract;
  my @s = lstat("$syncroot/$dto->[0]");
  return 'GONE' unless @s;
  my $type;
  my @info;
  if (-l _) {
    $type = '2';
    my $lc = readlink("$syncroot/$dto->[0]");
    return 'GONE' unless defined $lc;
    symlink($lc, $tmpnam) || die("symlink: $!\n");
    @info = linkinfo($tmpnam);
  } elsif (! -f _) {
    return 'GONE';
  } else {
    $type = '1';
    local *F;
    local *NF;
    open(F, '<', "$syncroot/$dto->[0]") || return 'GONE';
    @s = stat(F);
    die("stat: $!\n") unless @s;
    open(NF, '>', $tmpnam) || die("$tmpnam: $!\n");
    if ($dto->[0] !~ /\.[sr]pm$/) {
      @info = cpfile(*F, *NF);
    } else {
      @info = cprpm(*F, *NF);
      if (@info != 3) {
        defined(sysseek(F, 0, 0)) || die("sysseek: $!\n");
        close(NF);
        open(NF, '>', $tmpnam) || die("$tmpnam: $!\n");
        @info = cpfile(*F, *NF);
      }
    }
    close(F);
    close(NF) || die("$tmpnam: $!\n");
    fixmodetime($tmpnam, sprintf("1%03x%08x", ($s[2] & 07777), $s[9]));
  }
  @s = lstat($tmpnam);
  die("$tmpnam: $!\n") unless @s;
  if (@info == 3) {
    return 'RPM ', [ $dto->[0], "$s[9]/$s[7]/$s[1]", sprintf("1%03x%08x", ($s[2] & 07777), $s[9]), @info ];
  } else {
    return 'FILE', [ $dto->[0], "$s[9]/$s[7]/$s[1]", sprintf("$type%03x%08x", ($s[2] & 07777), $s[9]), @info ];
  }
}

sub file_send_fin {
}


#######################################################################
# rsync protocol
#######################################################################

sub sread {
  local *SS = shift;
  my $len = shift;
  $rvbytes += $len;
  my $ret = '';
  while ($len > 0) {
    my $r = sysread(SS, $ret, $len, length($ret));
    die("read error") unless $r;
    $len -= $r;
    die("read too much") if $r < 0;
  }
  return $ret;
}

sub swrite {
  local *SS = shift;
  my ($var, $len) = @_;
  $len = length($var) unless defined $len;
  $txbytes += $len;
  (syswrite(SS, $var, $len) || 0) == $len || die("syswrite: $!\n");
}

my $rsync_muxbuf = '';

sub muxread {
  local *SS = shift;
  my $len = shift;

  #print "muxread $len\n";
  while(length($rsync_muxbuf) < $len) {
    #print "muxbuf len now ".length($muxbuf)."\n";
    my $tag = '';
    $tag = sread(*SS, 4);
    $tag = unpack('V', $tag);
    my $tlen = 0+$tag & 0xffffff;
    $tag >>= 24;
    if ($tag == 7) {
      $rsync_muxbuf .= sread(*SS, $tlen);
      next;
    }
    if ($tag == 8 || $tag == 9) {
      my $msg = sread(*SS, $tlen);
      die("$msg\n") if $tag == 8;
      print "info: $msg\n";
      next;
    }
    die("unknown tag: $tag\n");
  }
  my $ret = substr($rsync_muxbuf, 0, $len);
  $rsync_muxbuf = substr($rsync_muxbuf, $len);
  return $ret;
}

my $have_md4;
my $rsync_checksum_seed;
my $rsync_protocol;

sub rsync_get_syncfiles {
  my $norecurse = shift;

  my $user = $syncuser;
  my $password = $syncpassword;
  if (!defined($have_md4)) {
    $have_md4 = 0;
    eval {
      require Digest::MD4;
      $have_md4 = 1;
    };
  }
  $syncroot =~ s/^\/+//;
  my $module = $syncroot;
  $module =~ s/\/.*//;
  my $tcpproto = getprotobyname('tcp');
  socket(S, PF_INET, SOCK_STREAM, $tcpproto) || die("socket: $!\n");
  connect(S, sockaddr_in($syncport, $syncaddr)) || die("connect: $!\n");
  my $hello = "\@RSYNCD: 28\n";
  swrite(*S, $hello);
  my $buf = '';
  sysread(S, $buf, 4096);
  die("protocol error [$buf]\n") if $buf !~ /^\@RSYNCD: (\d+)\n/s;
  $rsync_protocol = $1;
  $rsync_protocol = 28 if $rsync_protocol > 28;
  swrite(*S, "$module\n");
  while(1) {
    sysread(S, $buf, 4096);
    die("protocol error [$buf]\n") if $buf !~ s/\n//s;
    last if $buf eq "\@RSYNCD: OK";
    die("$buf\n") if $buf =~ /^\@ERROR/s;
    if ($buf =~ /^\@RSYNCD: AUTHREQD /) {
      die("'$module' needs authentification, but Digest::MD4 is not installed\n") unless $have_md4;
      $user = "nobody" if !defined($user) || $user eq '';
      $password = '' unless defined $password;
      my $digest = "$user ".Digest::MD4::md4_base64("\0\0\0\0$password".substr($buf, 18))."\n";
      swrite(*S, $digest);
      next;
    }
  }
  my @args = ('--server', '--sender', '-rl');
  push @args, '--exclude=/*/*' if $norecurse;
  for my $arg (@args, '.', "$syncroot/.", '') {
    swrite(*S, "$arg\n");
  }
  $rsync_checksum_seed = unpack('V', sread(*S, 4));
  swrite(*S, "\0\0\0\0");
  my @filelist;
  my $name = '';
  my $mtime = 0;
  my $mode = 0;
  my $uid = 0;
  my $gid = 0;
  my $flags;
  while(1) {
    $flags = muxread(*S, 1);
    $flags = ord($flags);
    # printf "flags = %02x\n", $flags;
    last if $flags == 0;
    $flags |= ord(muxread(*S, 1)) << 8 if $rsync_protocol >= 28 && ($flags & 0x04) != 0;
    my $l1 = $flags & 0x20 ? ord(muxread(*S, 1)) : 0;
    my $l2 = $flags & 0x40 ? unpack('V', muxread(*S, 4)) : ord(muxread(*S, 1));
    $name = substr($name, 0, $l1).muxread(*S, $l2);
    my $len = unpack('V', muxread(*S, 4));
    if ($len == 0xffffffff) {
      $len = unpack('V', muxread(*S, 4));
      my $len2 = unpack('V', muxread(*S, 4));
      $len += $len2 * 4294967296;
    }
    $mtime = unpack('V', muxread(*S, 4)) unless $flags & 0x80;
    $mode = unpack('V', muxread(*S, 4)) unless $flags & 0x02;
    my $id = "$mtime/$len/";
    my @info = ();
    my $mmode = $mode & 07777;
    if (($mode & 0170000) == 0100000) {
      @info = ('x');
      $mmode |= 0x1000;
    } elsif (($mode & 0170000) == 0040000) {
      $mmode |= 0x0000;
    } elsif (($mode & 0170000) == 0120000) {
      $mmode |= 0x2000;
      my $ln = muxread(*S, unpack('V', muxread(*S, 4)));
      @info = (Digest::MD5::md5_hex($ln));
      $id .= "$ln/";
    } else {
      print "$name: unknown mode: $mode\n";
      next;
    }
    push @filelist, [$name, $id, sprintf("%04x%08x", $mmode, $mtime), @info];
  }
  my $io_error = unpack('V', muxread(*S, 4));
  @filelist = sort {$a->[0] cmp $b->[0]} @filelist;
  my $fidx = 0;
  $_->[1] .= $fidx++ for @filelist;
  $newstamp1 = $newstamp2 = sprintf("%08x", time);
  return grep {$_->[0] ne '.'} @filelist;
}

sub rsync_adapt_filelist {
  my $fl = shift;
  my %c;
  for (@files) {
    my $i = $_->[1];
    $i =~ s/[^\/]+$//;
    $c{$i} = $_;
  }
  for (@$fl) {
    next if @$_ == 3 || $_->[3] ne 'x';
    my $i = $_->[1];
    $i =~ s/[^\/]+$//;
    next unless $c{$i};
    my @info = @{$c{$i}};
    splice(@info, 0, 3);
    splice(@$_, 3, 1, @info);
  }
}

sub rsync_get_update {
  my ($dto, $tmpnam, $reqext, $rextract) = @_;

  die("rextract in RSYNC transport\n") if $rextract;
  my $fidx = $dto->[1];
  if ($dto->[2] =~ /^2/) {
    $fidx =~ s/^[^\/]*\/[^\/]*\///s;
    $fidx =~ s/\/[^\/]*$//s;
    symlink($fidx, $tmpnam) || die("symlink: $!\n");
    my @s = lstat($tmpnam);
    die("$tmpnam: $!\n") unless @s;
    return 'FILE', [ $dto->[0], "$s[9]/$s[7]/$s[1]", sprintf("2%03x%08x", ($s[2] & 07777), $s[9]), linkinfo($tmpnam) ];
  }
  $fidx =~ s/.*\///;
  swrite(*S, pack('V', $fidx));
  swrite(*S, ("\0\0\0\0" x ($rsync_protocol >= 27 ? 4 : 3)));
  my $rfidx = unpack('V', muxread(*S, 4));
  die("rsync file mismatch $rfidx - $fidx\n") if $rfidx != $fidx;
  my $sumhead = muxread(*S, 4 * ($rsync_protocol >= 27 ? 4 : 3));
  my $md4ctx;
  $md4ctx = Digest::MD4->new if $have_md4;
  $md4ctx->add(pack('V', $rsync_checksum_seed)) if $have_md4;
  local *OF;
  open(OF, '>', $tmpnam) || die("$tmpnam: $!\n");
  while(1) {
    my $l = unpack('V', muxread(*S, 4));
    last if $l == 0;
    die("received negative token\n") if $l < 0;
    my $chunk = muxread(*S, $l);
    $md4ctx->add($chunk) if $have_md4;
    syswrite(OF, $chunk) == $l || die("syswrite: $!\n");
  }
  close(OF) || die("close: $!\n");
  my $md4sum = muxread(*S, 16);
  if ($have_md4) {
    die("data corruption on net\n") if unpack("H32", $md4sum) ne $md4ctx->hexdigest();
  }
  fixmodetime($tmpnam, $dto->[2]);
  my @s = lstat($tmpnam);
  die("$tmpnam: $!\n") unless @s;
  if ($dto->[0] =~ /\.[sr]pm$/) {
    return 'RPM ', [ $dto->[0], "$s[9]/$s[7]/$s[1]", sprintf("1%03x%08x", ($s[2] & 07777), $s[9]), rpminfo($tmpnam) ];
  } else {
    return 'FILE', [ $dto->[0], "$s[9]/$s[7]/$s[1]", sprintf("1%03x%08x", ($s[2] & 07777), $s[9]), fileinfo($tmpnam) ];
  }
}

sub rsync_send_fin {
  swrite(*S, pack('V', -1));      # switch to phase 2
  swrite(*S, pack('V', -1));      # switch to phase 3
  if ($rsync_protocol >= 24) {
    swrite(*S, pack('V', -1));    # goodbye
  }
  close(S);
}

#######################################################################
# drpmsync protocol
#######################################################################

my $sock_isopen;

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 {
  return copytofile_seek($_[0], $_[1], 0, $_[2], $_[3], $_[4]);
}

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

  local *FD;
  if ($extractoff) {
    open(FD, '+<', $fn) || die("$fn: $!\n");
    defined(sysseek(FD, $extractoff, 0)) || die("sysseek: $!\n");
  } else {
    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 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;
}

sub finishreq {
  local (*SOCK) = shift;
  my ($ans, $ctx, $id) = @_;

  if ($ctx) {
    $ans = tolength(*SOCK, $ans, 32);
    my $netmd5 = substr($ans, 0, 32);
    die("network error: bad md5 digest\n") if $netmd5 =~ /[^a-f0-9]/;
    my $md5 = $ctx->hexdigest;
    die("network error: $md5 should be $netmd5\n") if $md5 ne $netmd5;
    $ans = substr($ans, 32);
  }
  alarm(0) if $config_timeout;
  if ($have_time_hires && defined($net_start_tv)) {
    $net_spent_time += Time::HiRes::tv_interval($net_start_tv);
    $net_recv_bytes += $rvbytes - $net_start_rvbytes;
    $net_start_rvbytes = $rvbytes;
    undef $net_start_tv;
  }
  if ($id && ($id ne 'DRPMSYNK' || length($ans))) {
    close(SOCK);
    undef $sock_isopen;
  }
  return $ans;
}

sub drpmsync_get_syncfiles {
  my ($norecurse, $filelist_data) = @_;

  my $data;
  if (defined($filelist_data)) {
    $data = $filelist_data;
    goto use_filelist_data;
  }
  alarm($config_timeout) if $config_timeout;
  opensock() unless $sock_isopen;
  my $opts = '';
  $opts .= '&zlib' if $have_zlib;
  $opts .= '&norecurse' if $norecurse;
  if (@filter_comp) {
    my @fc = @filter_comp;
    while (@fc) {
      splice(@fc, 0, 2);
      my $r = shift @fc;
      $r =~ s/([\000-\040<>\"#&\+=%[\177-\377])/sprintf("%%%02X",ord($1))/sge;
      $opts .= "&filter=$r";
    }
  }
  if (@filter_arch_comp) {
    my @fc = @filter_arch_comp;
    while (@fc) {
      splice(@fc, 0, 2);
      my $r = shift @fc;
      $r =~ s/([\000-\040<>\"#&\+=%[\177-\377])/sprintf("%%%02X",ord($1))/sge;
      $opts .= "&filter_arch=$r";
    }
  }
  my $query = "GET $esyncroot/drpmsync/contents?drpmsync$opts 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);
  $data = substr($ans, 0, $anssize);
  $ans = substr($ans, $anssize);
  my $ctx = Digest::MD5->new;
  $ctx->add($data);
  $ans = finishreq(*S, $ans, $ctx, $id);
  $data = substr($data, 12);
  if ($type eq 'SYNZ') {
    die("cannot uncompress\n") unless $have_zlib;
    $data = Compress::Zlib::uncompress($data);
  }
use_filelist_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: $hex\n");
    }
  }
  # validate that no entry is listed twice
  my %ents;
  my %dirs;
  for (@syncfiles) {
    die("entry $_->[0] is listed twice\n") if exists $ents{$_->[0]};
    $ents{$_->[0]} = 1;
    if ($_->[2] =~ /^0/) {
      $dirs{$_->[0]} = 1;
      die("directory $_->[0] has bad data\n") unless @$_ == 3;
    } else {
      die("entry $_->[0] has bad data\n") unless @$_ > 3;
    }
  }
  # validate that all files are connected to dirs
  for (@syncfiles) {
    next unless /^(.*)\//;
    die("entry $_->[0] is not connected\n") unless $dirs{$1};
  }
  return @syncfiles;
}

sub drpmsync_send_fin {
  return 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 drpmsync_get_update {
  my ($dto, $tmpnam, $reqext, $rextract) = @_;

  my $d;
  my $extractoff = 0;
  if ($rextract) {
    die("bad extract parameter\n") unless $rextract =~ /^([0-9a-fA-F]{2})([0-9a-fA-F]{8}):[0-9a-fA-F]{8}$/;
    $extractoff = hex($1) * 4294967296 + hex($2);
  }

  my $req = aescape($dto->[0]);
  $req = "/$req?drpmsync";
  $req .= "&extract=$rextract" if $rextract;
  $req .= $reqext if $reqext;
# XXX print "-> $req\n";
  alarm($config_timeout) if $config_timeout;
  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");
  }
  $net_start_tv = [Time::HiRes::gettimeofday()] if $have_time_hires;
  $net_start_rvbytes = $rvbytes;
  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));
  if ($anssize == 4294967295) {
    $ans = tolength(*S, $ans, 32 + 10);
    $anssize = hex(substr($ans, 32, 2)) * 4294967296 + hex(substr($ans, 32 + 2, 8));
    $ans = substr($ans, 10);
  }
  $rvbytes += 32 + $namelen + $anssize + 32;
  if ($type eq 'ERR ') {
    $ans = tolength(*S, $ans, 32 + $namelen + $anssize);
    return $type , substr($ans, 32 + $namelen, $anssize);
  }
  $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);

  if ($type eq 'GONE' || $type eq 'NODR') {
    $ans = finishreq(*S, $ans, undef, $id);
    return $type;
  }
  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-f0-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-f0-9]/;
      }
    }
    $ans = substr($ans, $extralen);
    $anssize -= $extralen;
    $ctx->add($extra);
  }

  die("unexpected type $type\n") if $rextract && $type ne 'RPM ';

  if ($type eq 'FILZ') {
    die("cannot uncompress\n") unless $have_zlib;
    $ans = tolength(*S, $ans, $anssize);
    my $data = substr($ans, 0, $anssize);
    $ctx->add($data);
    $ans = finishreq(*S, substr($ans, $anssize), $ctx, $id);
    $data = Compress::Zlib::uncompress($data);
    my $datamd5 = Digest::MD5::md5_hex($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));
    }
    my @s = lstat($tmpnam);
    die("$tmpnam: $!\n") unless @s;
    if ($dto->[2] =~ /^2/) {
      $d = [ $dto->[0], "$s[9]/$s[7]/$s[1]", sprintf("2%03x%08x", ($s[2] & 07777), $s[9]), linkinfo($tmpnam) ];
    } else {
      $d = [ $dto->[0], "$s[9]/$s[7]/$s[1]", sprintf("1%03x%08x", ($s[2] & 07777), $s[9]), $datamd5 ];
    }
    return ('FILZ', $d);
  } elsif ($type eq 'FILE') {
    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 = finishreq(*S, $ans, $ctx, $id);
    fixmodetime($tmpnam, substr($extra, 0, 12)) if $dto->[2] !~ /^2/;
    my @s = lstat($tmpnam);
    die("$tmpnam: $!\n") unless @s;
    if ($dto->[2] =~ /^2/) {
      $d = [ $dto->[0], "$s[9]/$s[7]/$s[1]", sprintf("2%03x%08x", ($s[2] & 07777), $s[9]), linkinfo($tmpnam) ];
    } else {
      $d = [ $dto->[0], "$s[9]/$s[7]/$s[1]", sprintf("1%03x%08x", ($s[2] & 07777), $s[9]), fileinfo($tmpnam) ];
    }
    return ('FILE', $d);
  } elsif ($type eq 'FISO') {
    $ans = copytofile(*S, "$tmpnam.fiso", $ans, $anssize, $ctx);
    $ans = finishreq(*S, $ans, $ctx, $id);
    return 'FISO', [ $tmpnam, undef, substr($extra, 0, 12) ];
  } elsif ($type eq 'RPM ') {
    $sabytes -= $anssize;
    my $delta;
    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);
    while ($ndrpm > 0) {
      $delta = $tmpnam;
      $delta =~ s/[^\/]*$//;
      $delta .= substr($dextra, 12, 32 * 3);
      # end old job if we have a delta conflict
      checkjob() if $runningjob && -e $delta;
      my $size = hex(substr($dextra, 12 + 3 * 32, 8));
      die("delta rpm bigger than answer? $size > $anssize\n") if $size > $anssize;
      $ans = copytofile(*S, $delta, $ans, $size, $ctx);
      $anssize -= $size;
      fixmodetime($delta, substr($dextra, 0, 12));
      $dextra = substr($dextra, 12 + 32 * 3 + 8);
      push @deltas, $delta;
      $ndrpm--;
    }
    if ($nrpm == 1) {
      $ans = copytofile_seek(*S, $tmpnam, $extractoff, $ans, $anssize, $ctx);
      $ans = finishreq(*S, $ans, $ctx, $id);
      return 'RPM ', [ $dto->[0] ], @deltas if $rextract;
      fixmodetime($tmpnam, substr($extra, 0, 12));
      my @s = stat($tmpnam);
      die("$tmpnam: $!\n") unless @s;
      $sabytes += $s[7];
      $d = [ $dto->[0], "$s[9]/$s[7]/$s[1]", sprintf("1%03x%08x", ($s[2] & 07777), $s[9]), rpminfo($tmpnam) ];
    } else {
      die("junk at end of answer\n") if $anssize;
      $ans = finishreq(*S, $ans, $ctx, $id);
      $d = [ undef, undef, substr($extra, 0, 12) ];
    }
    return 'RPM ', $d, @deltas;
  } else {
    die("received strange answer type: $type\n");
  }
}


#######################################################################
# update functions
#######################################################################

sub save_or_delete_deltas {
  my ($bdir, $dpn, @deltas) = @_;

  if (!$config_keep_deltas || !$dpn) {
    for my $delta (@deltas) {
      unlink($delta) || die("unlink $delta: $!\n");
    }
    return;
  }
  my $ddir = "$bdir/drpmsync/deltas/$dpn";
  mkdir_p($ddir);
  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, "$ddir") || die("opendir $ddir: $!\n");
      my @dh = grep {$_ =~ /^[0-9a-f]{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("$ddir/$dh");
	die("$ddir/$dh: $!") unless @oldstat;
	if (system($combinedeltarpm, "$ddir/$dh", $delta, "$bdir/drpmsync/wip/$nn") || ! -f "$bdir/drpmsync/wip/$nn") {
	  recvlog_print("! combinedeltarpm $ddir/$dh $delta $bdir/drpmsync/wip/$nn failed");
	  unlink("$bdir/drpmsync/wip/$nn");
	  next;
	}
	utime($oldstat[9], $oldstat[9], "$bdir/drpmsync/wip/$nn");
	rename("$bdir/drpmsync/wip/$nn", "$ddir/$nn") || die("rename $bdir/drpmsync/wip/$nn $ddir/$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, "$ddir/$dn") || die("rename $delta $ddir/$dn: $!\n");
    }
  }
}


# get rpms for fiso, fill iso

sub update_fiso {
  my ($bdir, $pn, $dto, $rights) = @_;

  local *F;
  if (!open(F, '-|', $fragiso, 'list', "$bdir/drpmsync/wip/$pn.fiso")) {
    unlink("$bdir/drpmsync/wip/$pn.fiso");
    return undef;
  }
  my @frags = <F>;
  close(F) || return undef;
  chomp @frags;
  open(F, '>', "$bdir/drpmsync/wip/$pn") || die("$bdir/drpmsync/wip/$pn: $!\n");
  close(F);
  for my $f (@frags) {
    my @f = split(' ', $f, 3);
    update($bdir, [ $dto->[0], undef, $rights, $f[1], undef, $f[2] ], $f[0]);
  }
  checkjob() if $runningjob;
  my ($md5, $err) = runprg(undef, undef, $fragiso, 'fill', '-m', "$bdir/drpmsync/wip/$pn.fiso", "$bdir/drpmsync/wip/$pn");
  unlink("$bdir/drpmsync/wip/$pn.fiso") || die("unlink $bdir/drpmsync/wip/$pn.fiso: $!\n");;
  my $tmpnam = "$bdir/drpmsync/wip/$pn";
  if ($err) {
    recvlog_print("! fragiso fill failed: $err");
    unlink($tmpnam);
    return undef;
  }
  die("fragiso did not return md5\n") unless $md5 =~ /^[0-9a-f]{32}$/;
  fixmodetime($tmpnam, $rights);
  my @s = lstat($tmpnam);
  die("$tmpnam: $!\n") unless @s;
  $rights = sprintf("1%03x%08x", ($s[2] & 07777), $s[9]);
  $files{$dto->[0]} = [ $dto->[0], "$s[9]/$s[7]/$s[1]", $rights, $md5 ];
  rename($tmpnam, "$bdir/$dto->[0]") || die("rename $tmpnam $bdir/$dto->[0]: $!\n");
  if ($config_repo) {
    for my $f (@frags) {
      my @f = split(' ', $f, 3);
      repo_add("$bdir/$dto->[0]\@$f[0]", [ "$dto->[0]\@$f[0]", "$s[9]/$s[7]/$s[1]", $rights, $f[1], undef, $f[2] ] );
    }
  }
  return 1;
}


# called for files and rpms

sub update {
  my ($bdir, $dto, $rextract, $play_it_safe) = @_;

  my ($d, $nd, $md);
  my $pdto0;
  my @deltas;
  my $extractoff;
  my $tmpnam;

  if ($play_it_safe && ref($play_it_safe)) {
    # poor mans co-routine implementation...
    my $job = $play_it_safe;
    $d = $job->{'d'};
    $nd = $job->{'nd'};
    $md = $job->{'md'};
    $pdto0 = $job->{'pdto0'};
    $tmpnam = $job->{'tmpnam'};
    $extractoff = $job->{'extractoff'};
    @deltas = applydeltas_finish($job);
    goto applydeltas_finished;
  }

  die("can only update files and symlinks\n") if $dto->[2] !~ /^[12]/;
  $pdto0 = $dto->[0];        # for recvlog_print;

  # hack: patch source/dest for special fiso request
  if ($rextract) {
    die("bad extract parameter\n") unless $rextract =~ /^([0-9a-fA-F]{2})([0-9a-fA-F]{8}):[0-9a-fA-F]{8}$/;
    $extractoff = hex($1) * 4294967296 + hex($2);
    die("bad extract offset\n") unless $extractoff;
    $pdto0 = "$dto->[0]\@$rextract ($dto->[5])";
  }

  $d = $files{$dto->[0]};
  if ($d && !$rextract && $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\//;		# patch cache id
      return;
    }
  }

  # check for simple renames
  if (!$d && !$rextract && substr($dto->[2], 0, 1) eq '1') {
    # search for same md5, same mtime and removed files
    my @oldds = grep {@$_ > 3 && $_->[3] eq $dto->[3] && substr($_->[2], 4) eq substr($dto->[2], 4) && !$syncfiles{$_->[0]}} values %files;
    if (@oldds) {
      $d = $oldds[0];
      my $pn = $dto->[0];
      $pn =~ s/.*\///;
      $tmpnam = "$bdir/drpmsync/wip/$pn";
      checkjob($pn) if $runningjob;
      # rename it
      if (rename("$bdir/$d->[0]", $tmpnam)) {
	delete $files{$d->[0]};
        recvlog_print("- $d->[0]");
        repo_del("$bdir/$d->[0]", $d) if $config_repo;
        my @s = stat($tmpnam);
        # check link count, must be 1
        if (!@s || $s[3] != 1) {
	  unlink($tmpnam);	# oops
	} else {
          fixmodetime($tmpnam, $dto->[2]);
          @s = stat($tmpnam);
	  die("$tmpnam: $!\n") unless @s;
	  my @info = @$d;
	  splice(@info, 0, 3);
	  $files{$dto->[0]} = [ $dto->[0], "$s[9]/$s[7]/$s[1]", sprintf("1%03x%08x", ($s[2] & 07777), $s[9]), @info ];
          recvlog_print("M $dto->[0]");
	  rename($tmpnam, "$bdir/$dto->[0]") || die("rename $tmpnam $bdir/$dto->[0]: $!\n");
	  repo_add("$bdir/$dto->[0]", $files{$dto->[0]}) if $config_repo;
	  # no need to create delta, as file was already in tree...
	  return;
	}
      }
      undef $d;
    }
  }

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

  $md = $d;	# make delta against this entry ($d may point to repo)
  my $repo_key = '';
  my @repo;
  my $deltaonly;

  if ($config_repo && @$dto > 5) {
    @repo = repo_search($dto->[5], $dto->[3]);
    # we must not use the repo if we need to store the deltas.
    # in this case we will send a delta-only request and retry the
    # repo if it fails
    if (@repo && !$rextract && !$config_generate_deltas && $config_keep_deltas) {
      @repo = repo_check(@repo);
      $deltaonly = 1 if @repo;
    }
  }

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

send_again:

  while (@repo && !$deltaonly) {
    my $rd;
    my $pn = $dto->[0];
    $pn =~ s/^.*\///;
    checkjob($pn) if $runningjob;
    if ($repo[0]->[0] eq $dto->[3]) {
      # exact match, great!
      $tmpnam = "$bdir/drpmsync/wip/$pn";
      $rd = repo_cp($repo[0], $bdir, "drpmsync/wip/$pn", $extractoff);
      if (!$rd) {
	shift @repo;
	next;
      }
      if ($rextract) {
	recvlog_print("R $pdto0");
	return;
      }
      fixmodetime($tmpnam, $dto->[2]);
      my @s = stat($tmpnam);
      die("$tmpnam: $!\n") unless @s;
      my $oldd5 = $md ? substr($md->[3], 32) : undef;
      $files{$dto->[0]} = [ $dto->[0], "$s[9]/$s[7]/$s[1]", sprintf("1%03x%08x", ($s[2] & 07777), $s[9]), $rd->[3], $rd->[4], $rd->[5] ];
      if ($oldd5 && $config_generate_deltas) {
	recvlog_print("Rm $pdto0");
	@deltas = makedelta("$bdir/$md->[0]", $tmpnam, "$bdir/drpmsync/wip/$oldd5$files{$dto->[0]}->[3]");
	save_or_delete_deltas($bdir, $dto->[5], @deltas);
      } else {
	recvlog_print("R $pdto0");
      }
      rename($tmpnam, "$bdir/$dto->[0]") || die("rename $tmpnam $bdir/$dto->[0]: $!\n");
      repo_add("$bdir/$dto->[0]", $files{$dto->[0]});
      return;
    } elsif (substr($repo[0]->[0], 32, 32) eq substr($dto->[3], 32, 32)) {
      # have sign only rpm, copy right away
      checkjob() if $runningjob;
      $rd = repo_cp($repo[0], $bdir, "drpmsync/wip/repo-$pn");
      if (!$rd) {
	shift @repo;
	next;
      }
      $d = $rd;
      $d->[1] = undef;	# mark as temp, don't gen/save delta
      $repo_key = 'R';
      @repo = ();
    }
    @repo = repo_check(@repo) if @repo;
    last;
  }

  # ok, we really need to send a request our server
  my $reqext = '';
  if (@repo && !$deltaonly && !$play_it_safe) {
    my @h = map {$_->[0]} @repo;
    unshift @h, $d->[3] if $d && @$d > 5;
    $reqext .= "&have=" . shift(@h);
    if (@h) {
      my %ha = map {substr($_, -32, 32) => 1} @h;
      $reqext .= "&havealso=" . join(',', keys %ha);
    }
  } elsif ($d && @$d > 5 && !$play_it_safe) {
    $reqext .= "&have=$d->[3]";
    $reqext .= "&uncombined" if $config_keep_uncombined;
    $reqext .= "&withrpm" if $config_always_get_rpm && substr($d->[3], 32) ne substr($dto->[3], 32);
    $reqext .= "&deltaonly" if $deltaonly;
    $reqext .= "&nocomplexdelta" if (!$config_keep_deltas || $rextract) && $config_always_get_rpm;
  } else {
    $reqext .= "&zlib" if $have_zlib;
    $reqext .= "&fiso" if $config_repo && !$play_it_safe && ($dto->[0] =~ /(?<!\.delta)\.iso$/i);
  }

  my $pn = $dto->[0];
  $pn =~ s/^.*\///;
  die("no file name?\n") unless $pn ne '';
  checkjob($pn) if $runningjob;
  $tmpnam = "$bdir/drpmsync/wip/$pn";
  my $type;
  ($type, $nd, @deltas) = get_update($dto, $tmpnam, $reqext, $rextract);
  if ($type eq 'ERR ') {
    die("$nd\n");
  } elsif ($type eq 'NODR') {
    die("unexpected NODR answer\n") unless $deltaonly;
    $deltaonly = 0;
    goto send_again;
  } elsif ($type eq 'GONE') {
    warn("$dto->[0] is gone\n");
    recvlog_print("${repo_key}G $pdto0");
    if (-e "$bdir/$dto->[0]") {
      unlink("$bdir/$dto->[0]") || die("unlink $bdir/$dto->[0]: $!\n");
    }
    delete $files{$dto->[0]};
    $had_gone = 1;
  } elsif ($type eq 'FILZ') {
    recvlog_print("${repo_key}z $pdto0");
    rename($tmpnam, "$bdir/$dto->[0]") || die("rename $tmpnam $bdir/$dto->[0]: $!\n");
    $files{$dto->[0]} = $nd;
  } elsif ($type eq 'FILE') {
    recvlog_print("${repo_key}f $pdto0");
    rename($tmpnam, "$bdir/$dto->[0]") || die("rename $tmpnam $bdir/$dto->[0]: $!\n");
    $files{$dto->[0]} = $nd;
  } elsif ($type eq 'FISO') {
    checkjob() if $runningjob;
    recvlog_print("${repo_key}i $pdto0");
    if (!update_fiso($bdir, $pn, $dto, $nd->[2])) {
      $play_it_safe = 1;
      goto send_again;
    }
  } elsif ($type eq 'RPM ') {
    if (!$nd->[0]) {
      checkjob() if $runningjob;
      die("no deltas?") unless @deltas;
      undef $d if $d && (@$d <= 4 || substr($d->[3], 32, 32) ne substr($deltas[0], -96, 32));
      if (!$d && @repo) {
	my $dmd5 = substr($deltas[0], -96, 32);
        my @mrepo = grep {substr($_->[0], 32, 32) eq $dmd5} @repo;
	for my $rd (@mrepo) {
	  $d = repo_cp($rd, $bdir, "drpmsync/wip/repo-$pn");
	  last if $d;
	}
	if (!$d && @mrepo) {
	  recvlog_print("R! $pdto0");
	  save_or_delete_deltas($bdir, undef, @deltas);
          @repo = grep {substr($_->[0], 32, 32) ne $dmd5} @repo;
	  goto send_again;	# now without bad repo entries
	}
	$d->[1] = undef if $d;
        $repo_key = 'R';
      }
      if (@deltas == 1 && substr($deltas[0], -96, 32) eq substr($deltas[0], -32, 32)) {
	recvlog_print("${repo_key}s $pdto0");
      } else {
	recvlog_print("${repo_key}d $pdto0");
      }
      die("received delta doesn't match request\n") unless $d;

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

      if (1) {
	my $job = {};
	$job->{'d'} = $d;
	$job->{'nd'} = $nd;
	$job->{'md'} = $md;
	$job->{'pdto0'} = $pdto0;
	$job->{'tmpnam'} = $tmpnam;
	$job->{'extractoff'} = $extractoff;
        $job->{'wip'} = $pn;
        $job->{'finish'} = \&update;
        $job->{'finishargs'} = [$bdir, $dto, $rextract, $job];
        @deltas = applydeltas($job, "$bdir/$d->[0]", $tmpnam, $extractoff, @deltas);
	if (@deltas) {
	    $runningjob = $job;
	    return;
	}
        delete $job->{'finishargs'};	# break circ ref
      }

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

      #recvlog("applying deltarpm to $d->[0]");
      #@deltas = applydeltas("$bdir/$d->[0]", $tmpnam, $extractoff, @deltas);
applydeltas_finished:
      if (!@deltas) {
	return update($bdir, $dto, $rextract, 1);
      }
      if (!$rextract) {
        fixmodetime($tmpnam, $nd->[2]);
        my @s = stat($tmpnam);
        die("$tmpnam: $!\n") unless @s;
        $sabytes += $s[7];
        $nd = [ $dto->[0], "$s[9]/$s[7]/$s[1]", sprintf("1%03x%08x", ($s[2] & 07777), $s[9]), rpminfo($tmpnam) ];
      }
    } else {
      recvlog_print("${repo_key}r $pdto0") if $rextract || !(!@deltas && $md && $md->[1] && $config_generate_deltas);
    }
    if ($rextract) {
      save_or_delete_deltas($bdir, undef, @deltas);
      unlink("$bdir/$d->[0]") if $d && ($d->[0] =~ m!drpmsync/wip/repo-!);
      return;
    }
    if (@deltas && $d && !$d->[1]) {
      # deltas made against some repo rpm, always delete
      save_or_delete_deltas($bdir, undef, @deltas);
      @deltas = ();
    }
    if (!@deltas && $md && $md->[1] && $config_generate_deltas) {
      recvlog_print("${repo_key}m $pdto0");
      @deltas = makedelta("$bdir/$md->[0]", $tmpnam, "$bdir/drpmsync/wip/".substr($md->[3], 32).$nd->[3]);
    }
    save_or_delete_deltas($bdir, $dto->[5], @deltas);

    rename($tmpnam, "$bdir/$dto->[0]") || die("rename $tmpnam $bdir/$dto->[0]: $!\n");
    $files{$dto->[0]} = $nd;
    repo_add("$bdir/$dto->[0]", $nd) if $config_repo;
  } else {
    die("received strange answer type: $type\n");
  }
  unlink("$bdir/$d->[0]") if $d && ($d->[0] =~ m!drpmsync/wip/repo-!);
}

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 $fn: $!\n");
  utime($ti, $ti, $fn) == 1 || die("utime $fn: $!\n");
}

my $cmdline_cf;
my $cmdline_source;
my $cmdline_repo;
my $cmdline_repo_add;
my $cmdline_repo_validate;
my $cmdline_get_filelist;
my $cmdline_use_filelist;
my $cmdline_norecurse;
my $cmdline_list;
my @cmdline_filter;
my @cmdline_filter_arch;

sub find_source {
  my ($syncfilesp, $norecurse, $verbose, @sources) = @_;
  my %errors;

  if (!@sources) {
    setup_proto('null');
    @$syncfilesp = ();
    return;
  }
  for my $s (@sources) {
    $syncurl = $s;
    my $ss = $s;
    $syncproto = 'drpmsync';
    if ($ss =~ /^(file|drpmsync|rsync):(.*)$/) {
      $syncproto = lc($1);
      $ss = $2;
      if ($syncproto ne 'file') {
        $ss =~ s/^\/\///;
        if ($ss =~ /^([^\/]+)\@(.*)$/) {
          $syncuser = $1;
          $ss = $2;
          ($syncuser, $syncpassword) = split(':', $syncuser, 2);
        }
      }
    }
    if ($syncproto eq 'file') {
      $syncroot = $ss;
      $syncroot =~ s/\/\.$//;
      $syncroot =~ s/\/$// unless $syncroot eq '/';
    } else {
      ($syncaddr, $syncport, $syncroot) = $ss =~ /^([^\/]+?)(?::(\d+))?(\/.*)$/;
      if (!$syncaddr) {
        $errors{$s} = "bad url";
        next;
      }
      $syncroot =~ s/\/\.$//;
      $syncroot =~ s/\/$// unless $syncroot eq '/';
      $esyncroot = aescape($syncroot);
      $syncport ||= $syncproto eq 'rsync' ? 873 : 80;
      $syncaddr = inet_aton($syncaddr);
      if (!$syncaddr) {
        $errors{$s} = "could not resolve host";
        next;
      }
      print "trying $s\n" if $verbose;
    }
    eval {
      setup_proto($syncproto);
      @$syncfilesp = get_syncfiles($norecurse);
    };
    alarm(0) if $config_timeout;
    last unless $@;
    $errors{$s} = "$@";
    $errors{$s} =~ s/\n$//s;
    undef $syncaddr;
  }
  if ($syncproto ne 'file' && !$syncaddr) {
    if (@sources == 1) {
      die("could not connect to $sources[0]: $errors{$sources[0]}\n");
    } else {
      print STDERR "could not connect to any server:\n";
      print STDERR "  $_: $errors{$_}\n" for @sources;
      exit(1);
    }
  }
  filelist_apply_filter($syncfilesp);
  filelist_apply_filter_arch($syncfilesp);
}

sub filelist_from_file {
  my ($flp, $fn) = @_;

  local *FL;
  if ($fn eq '-') {
    open(FL, '<&STDIN') || die("STDIN dup: $!\n");
  } else {
    open(FL, '<', $fn) || die("$fn: $!\n");
  }
  my $fldata;
  my $data;
  my $is_compressed;
  die("not a drpmsync filelist\n") if read(FL, $data, 32) != 32;
  if (substr($data, 0, 2) eq "\037\213") {
    { local $/; $data .= <FL>; }
    $data = Compress::Zlib::memGunzip($data);
    die("filelist uncompress error\n") unless defined $data;
    $is_compressed = 1;
  }
  die("not a drpmsync filelist\n") if (substr($data, 0, 24) ne 'DRPMSYNC0001SYNC00000000' && substr($data, 0, 24) ne 'DRPMSYNC0001SYNZ00000000');
  if ($is_compressed) {
    $fldata = substr($data, 32);
    $data = substr($data, 0, 32);
  } else {
    { local $/; $fldata = <FL>; }
  }
  close FL;
  my $md5 = substr($fldata, -32, 32);
  $fldata = substr($fldata, 0, -32);
  die("drpmsync filelist checksum error\n") if Digest::MD5::md5_hex($fldata) ne $md5;
  $fldata = substr($fldata, 12);
  if (substr($data, 16, 4) eq 'SYNZ') {
    die("cannot uncompress filelist\n") unless $have_zlib;
    $fldata = Compress::Zlib::uncompress($fldata);
  }
  @$flp = drpmsync_get_syncfiles($cmdline_norecurse, $fldata);
  filelist_apply_filter($flp);
  filelist_apply_filter_arch($flp);
}

while (@ARGV) {
  last if $ARGV[0] !~ /^-/;
  my $opt = shift @ARGV;
  last if $opt eq '--';
  if ($opt eq '-c') {
    die("-c: argument required\n") unless @ARGV;
    $cmdline_cf = shift @ARGV;
  } elsif ($opt eq '--repo') {
    die("--repo: argument required\n") unless @ARGV;
    $cmdline_repo = shift @ARGV;
  } elsif ($opt eq '--repo-add') {
    $cmdline_repo_add = 1;
  } elsif ($opt eq '--repo-validate') {
    $cmdline_repo_validate = 1;
  } elsif ($opt eq '--norecurse-validate') {
    $cmdline_norecurse = 1;
  } elsif ($opt eq '--list') {
    $cmdline_list = 1;
    $cmdline_norecurse = 1;
  } elsif ($opt eq '--list-recursive') {
    $cmdline_list = 1;
  } elsif ($opt eq '--get-filelist') {
    die("--get-filelist: argument required\n") unless @ARGV;
    $cmdline_get_filelist = shift @ARGV;
  } elsif ($opt eq '--filelist-synctree') {
    $synctree = shift @ARGV;
    $synctree .= '/';
  } elsif ($opt eq '--use-filelist') {
    die("--use-filelist: argument required\n") unless @ARGV;
    $cmdline_use_filelist = shift @ARGV;
  } elsif ($opt eq '--exclude') {
    die("--exclude: argument required\n") unless @ARGV;
    push @cmdline_filter, '-'.shift(@ARGV);
  } elsif ($opt eq '--include') {
    die("--include: argument required\n") unless @ARGV;
    push @cmdline_filter, '+'.shift(@ARGV);
  } elsif ($opt eq '--exclude-arch') {
    die("--exclude-arch: argument required\n") unless @ARGV;
    push @cmdline_filter_arch, '-'.shift(@ARGV);
  } elsif ($opt eq '--include-arch') {
    die("--include-arch: argument required\n") unless @ARGV;
    push @cmdline_filter_arch, '+'.shift(@ARGV);
  } else {
    die("$opt: unknown option\n");
  }
}

if ($cmdline_repo_validate) {
  my $basedir;
  $basedir = shift @ARGV if @ARGV;
  die("illegal source parameter for repo operation\n") if @ARGV;
  if (defined($cmdline_cf) || (defined($basedir) && -e "$basedir/drpmsync/config")) {
    readconfig_client(defined($cmdline_cf) ? $cmdline_cf : "$basedir/drpmsync/config");
  }
  $config_repo = $cmdline_repo if defined $cmdline_repo;
  die("--repo-validate: no repo specified\n") unless $config_repo;
  repo_validate();
  exit(0);
}

my $basedir;
if (@ARGV == 2) {
  die("illegal source parameter for repo operation\n") if $cmdline_repo_add;
  $cmdline_source = shift @ARGV;
  $basedir = $ARGV[0];
} elsif (@ARGV == 1) {
  if ($cmdline_list || defined($cmdline_get_filelist)) {
    $cmdline_source = $ARGV[0];
  } else {
    $basedir = $ARGV[0];
  }
} else {
  die("Usage: drpmsync [-c config] [source] <dir> | -s <serverconfig>\n") unless $cmdline_list && defined($cmdline_use_filelist);
}

if (defined($basedir)) {
  if (-f $basedir) {
    die("$basedir: not a directory (did you forget -s?)\n");
  }
  mkdir_p($basedir);
}

if (defined($cmdline_cf)) {
  readconfig_client($cmdline_cf);
} elsif (defined($basedir) && (-e "$basedir/drpmsync/config")) {
  readconfig_client("$basedir/drpmsync/config");
}

@config_source = $cmdline_source if defined $cmdline_source;
$config_repo = $cmdline_repo if defined $cmdline_repo;
@filter_comp = compile_filter(@cmdline_filter, @config_filter);
@filter_arch_comp = compile_filter(@cmdline_filter_arch, @config_filter_arch);

if ($config_repo && defined($basedir)) {
  my $nbasedir = `cd $basedir && /bin/pwd`;
  chomp $nbasedir;
  die("could not canonicalize $basedir\n") if !$nbasedir || !-d "$nbasedir";
  $basedir = $nbasedir;
}

if ($cmdline_repo_add) {
  die("--repo-add: no repo specified\n") unless $config_repo;
  die("need a destination\n") unless defined $basedir;
  readcache("$basedir/drpmsync/cache");
  print "getting state of local tree...\n";
  findfiles($basedir, '');
  print("cache:  $cachehits hits, $cachemisses misses\n");
  for my $d (@files) {
    repo_add("$basedir/$d->[0]", $d);
  }
  exit(0);
}

if (defined($cmdline_get_filelist)) {
  die("need a source for get-filelist\n") unless @config_source;
  $SIG{'ALRM'} = sub {die("network timeout\n");};
  my @syncfiles;
  find_source(\@syncfiles, $cmdline_norecurse, $cmdline_get_filelist eq '-' ? 0 : 1, @config_source);
  send_fin();
  filelist_from_file(\@syncfiles, $cmdline_use_filelist) if defined $cmdline_use_filelist;
  local *FL;
  if ($cmdline_get_filelist eq '-') {
    open(FL, '>&STDOUT') || die("STDOUT dup: $!\n");
  } else {
    open(FL, '>', $cmdline_get_filelist) || die("$cmdline_get_filelist: $!\n");
  }
  my $data;
  $data = pack('H*', "$newstamp1$newstamp2");
  $data = pack("Nw/a*w/a*", scalar(@syncfiles), $synctree ne '/' ? substr($synctree, 0, -1) : '/', $data);
  $data = sprintf("1%03x%08x", 0644, time()).$data;
  for (@syncfiles) {
    my @l = @$_;
    my $b;
    if (@l > 5) {
      $b = pack('H*', "$l[2]$l[3]$l[4]").$l[5];
    } elsif (@l > 3) {
      if ($l[3] eq 'x') {
        $b = pack('H*', $l[2])."\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0";
      } else {
        $b = pack('H*', "$l[2]$l[3]");
      }
    } else {
      $b = pack('H*', $l[2]);
    }
    $data .= pack("w/a*w/a*", $l[0], $b);
  }
  $data = "DRPMSYNC0001SYNC00000000".sprintf("%08x", length($data)).$data.Digest::MD5::md5_hex($data);
  print FL $data;
  close(FL) || die("close: $!\n");
  exit(0);
}

if ($cmdline_list) {
  $SIG{'ALRM'} = sub {die("network timeout\n");};
  my @syncfiles;
  find_source(\@syncfiles, $cmdline_norecurse, 0, @config_source);
  send_fin();
  filelist_from_file(\@syncfiles, $cmdline_use_filelist) if defined $cmdline_use_filelist;
  for my $f (@syncfiles) {
    my $p = substr($f->[2], 0, 1) eq '0' ? '/' : '';
    print "$f->[0]$p\n";
  }
  exit(0);
}

# get the lock

die("need a destination\n") unless defined $basedir;
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-f]/) {
    $oldstamp1 = substr($s, 0, 8);
    $oldstamp2 = substr($s, 8, 8);
  }
  close STAMP;
}
$oldstamp1 ||= "00000000";

# 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, '', 1);
print("cache:  $cachehits hits, $cachemisses misses\n");
writecache("$basedir/drpmsync/cache");

if (!@config_source) {
  # just a cache update...
  unlink("$basedir/drpmsync/lock");
  close(LOCK);
  exit(0);
}

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

$SIG{'ALRM'} = sub {die("network timeout\n");};

my @syncfiles;
find_source(\@syncfiles, $cmdline_norecurse || $cmdline_use_filelist, 1, @config_source);
filelist_from_file(\@syncfiles, $cmdline_use_filelist) if defined $cmdline_use_filelist;

$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");
  $SIG{'__DIE__'} = sub {
    my $err = $_[0];
    $err =~ s/\n$//s;
    recvlog($err);
    die("$err\n");
  };
}

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";

rsync_adapt_filelist(\@syncfiles) if $syncproto eq 'rsync';

%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");
    }
    repo_del("$basedir/$subf->[0]", $subf) if $config_repo;
    delete $files{$subf->[0]};
  }
  dirchanged($dir->[0]);
  @files = sort {$a->[0] cmp $b->[0]} values %files;
}

# part 3
my @syncrpms = grep {@$_ > 5} @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);
}

checkjob() if $runningjob;

send_fin();

# 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");
    repo_del("$basedir/$file->[0]", $file) if $config_repo;
  }
  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");

if (!$had_gone) {
  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;
}
my $net_kbsec = 0;
$net_kbsec = int($net_recv_bytes / 1024 / $net_spent_time) if $net_spent_time;
recvlog("update finished $txbytes/$rvbytes/$sabytes $net_kbsec");
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;
}
printf "network throughput %d kbyte/sec\n", $net_kbsec if $net_spent_time; 
exit 24 if $had_gone;