1#!/usr/local/bin/perl -w 2 3# 4# Copyright (c) 2005 Michael Schroeder (mls@suse.de) 5# 6# This program is licensed under the BSD license, read LICENSE.BSD 7# for further information 8# 9 10use Socket; 11use Fcntl qw(:DEFAULT :flock); 12use POSIX; 13use Digest::MD5 (); 14use Net::Domain (); 15use bytes; 16my $have_zlib; 17my $have_time_hires; 18eval { 19 require Compress::Zlib; 20 $have_zlib = 1; 21}; 22eval { 23 require Time::HiRes; 24 $have_time_hires = 1 if defined &Time::HiRes::gettimeofday; 25}; 26use strict; 27 28$SIG{'PIPE'} = 'IGNORE'; 29 30####################################################################### 31# Common code user for Client and Server 32####################################################################### 33 34my $makedeltarpm = 'makedeltarpm'; 35my $combinedeltarpm = 'combinedeltarpm'; 36my $applydeltarpm = 'applydeltarpm'; 37my $fragiso = 'fragiso'; 38 39sub stdinopen { 40 local *F = shift; 41 local *I = shift; 42 my $pid; 43 while (1) { 44 $pid = open(F, '-|'); 45 last if defined $pid; 46 return if $! != POSIX::EAGAIN; 47 sleep(5); 48 } 49 return 1 if $pid; 50 if (fileno(I) != 0) { 51 open(STDIN, "<&I") || die("dup stdin: $!\n"); 52 close(I); 53 } 54 exec @_; 55 die("$_[0]: $!\n"); 56} 57 58sub tmpopen { 59 local *F = shift; 60 my $tmpdir = shift; 61 62 my $tries = 0; 63 for ($tries = 0; $tries < 100; $tries++) { 64 if (sysopen(F, "$tmpdir/drpmsync.$$.$tries", POSIX::O_RDWR|POSIX::O_CREAT|POSIX::O_EXCL, 0600)) { 65 unlink("$tmpdir/drpmsync.$$.$tries"); 66 return 1; 67 } 68 } 69 return; 70} 71 72# cannot use IPC::Open3, sigh... 73sub runprg { 74 return runprg_job(undef, @_); 75} 76 77sub runprg_job { 78 my ($job, $if, $of, @prg) = @_; 79 local (*O, *OW, *E, *EW); 80 if (!$of) { 81 pipe(O, OW) || die("pipe: $!\n"); 82 } 83 pipe(E, EW) || die("pipe: $!\n"); 84 my $pid; 85 while (1) { 86 $pid = fork(); 87 last if defined $pid; 88 return ('', "runprg: fork: $!") if $! != POSIX::EAGAIN; 89 sleep(5); 90 } 91 if ($pid == 0) { 92 if ($of) { 93 *OW = $of; 94 } else { 95 close(O); 96 } 97 close(E); 98 if (fileno(OW) != 1) { 99 open(STDOUT, ">&OW") || die("dup stdout: $!\n"); 100 close(OW); 101 } 102 if (fileno(EW) != 2) { 103 open(STDERR, ">&EW") || die("dup stderr: $!\n"); 104 close(EW); 105 } 106 if (defined($if)) { 107 local (*I) = $if; 108 if (fileno(I) != 0) { 109 open(STDIN, "<&I") || die("dup stdin: $!\n"); 110 close(I); 111 } 112 } else { 113 open(STDIN, "</dev/null"); 114 } 115 exec @prg; 116 die("$prg[0]: $!\n"); 117 } 118 close(OW) unless $of; 119 close(EW); 120 121 if ($job) { 122 $job->{'PID'} = $pid; 123 $job->{'E'} = *E; 124 delete $job->{'O'}; 125 $job->{'O'} = *O unless $of; 126 return $job; 127 } 128 $job = {}; 129 $job->{'PID'} = $pid; 130 $job->{'E'} = *E; 131 $job->{'O'} = *O unless $of; 132 return runprg_finish($job); 133} 134 135sub runprg_finish { 136 my ($job) = @_; 137 138 die("runprg_finish: no job running\n") unless $job && $job->{'PID'}; 139 my ($out, $err) = ('', ''); 140 my $pid = $job->{'PID'}; 141 local *E = $job->{'E'}; 142 local *O; 143 my $of = 1; 144 if (exists $job->{'O'}) { 145 $of = undef; 146 *O = $job->{'O'}; 147 } 148 delete $job->{'PID'}; 149 delete $job->{'O'}; 150 delete $job->{'E'}; 151 my $rin = ''; 152 my $efd = fileno(E); 153 my $ofd; 154 if (!$of) { 155 $ofd = fileno(O); 156 vec($rin, $ofd, 1) = 1; 157 } 158 vec($rin, $efd, 1) = 1; 159 my $nfound; 160 my $rout; 161 my $openfds = $of ? 2 : 3; 162 while ($openfds) { 163 $nfound = select($rout = $rin, undef, undef, undef); 164 if (!defined($nfound)) { 165 $err .= "select: $!"; 166 close(O) if $openfds & 1; 167 close(E) if $openfds & 2; 168 last; 169 } 170 if (!$of && vec($rout, $ofd, 1)) { 171 if (!sysread(O, $out, 4096, length($out))) { 172 vec($rin, $ofd, 1) = 0; 173 close(O); 174 $openfds &= ~1; 175 } 176 } 177 if (vec($rout, $efd, 1)) { 178 if (!sysread(E, $err, 4096, length($err))) { 179 vec($rin, $efd, 1) = 0; 180 close(E); 181 $openfds &= ~2; 182 } 183 } 184 } 185 while(1) { 186 if (waitpid($pid, 0) == $pid) { 187 $err = "Error $?" if $? && $err eq ''; 188 last; 189 } 190 if ($! != POSIX::EINTR) { 191 $err = "waitpid: $!"; 192 last; 193 } 194 } 195 return ($out, $err); 196} 197 198sub cprpm { 199 local *F = shift; 200 my ($wri, $verify, $ml) = @_; 201 202 local *WF; 203 *WF = $wri if $wri; 204 205 my $ctx; 206 $ctx = Digest::MD5->new if $verify; 207 208 my $buf = ''; 209 my $l; 210 while (length($buf) < 96 + 16) { 211 $l = sysread(F, $buf, defined($ml) && $ml < 4096 ? $ml : 4096, length($buf)); 212 return "read error" unless $l; 213 $ml -= $l if defined $ml; 214 } 215 my ($magic, $sigtype) = unpack('N@78n', $buf); 216 return "not a rpm (bad magic of header type" unless $magic == 0xedabeedb && $sigtype == 5; 217 my ($headmagic, $cnt, $cntdata) = unpack('@96N@104NN', $buf); 218 return "not a rpm (bad sig header magic)" unless $headmagic == 0x8eade801; 219 my $hlen = 96 + 16 + $cnt * 16 + $cntdata; 220 $hlen = ($hlen + 7) & ~7; 221 while (length($buf) < $hlen) { 222 $l = sysread(F, $buf, defined($ml) && $ml < 4096 ? $ml : 4096, length($buf)); 223 return "read error" unless $l; 224 $ml -= $l if defined $ml; 225 } 226 my $lmd5 = Digest::MD5::md5_hex(substr($buf, 0, $hlen)); 227 my $idxarea = substr($buf, 96 + 16, $cnt * 16); 228 if (!($idxarea =~ /\A(?:.{16})*\000\000\003\354\000\000\000\007(....)\000\000\000\020/s)) { 229 return "no md5 signature header"; 230 } 231 my $md5off = unpack('N', $1); 232 return "bad md5 offset" if $md5off >= $cntdata; 233 $md5off += 96 + 16 + $cnt * 16; 234 my $hmd5 = unpack("\@${md5off}H32", $buf); 235 return "write error" if $wri && (syswrite(WF, substr($buf, 0, $hlen)) || 0) != $hlen; 236 $buf = substr($buf, $hlen); 237 while (length($buf) < 16) { 238 $l = sysread(F, $buf, defined($ml) && $ml < 4096 ? $ml : 4096, length($buf)); 239 return "read error" unless $l; 240 $ml -= $l if defined $ml; 241 } 242 ($headmagic, $cnt, $cntdata) = unpack('N@8NN', $buf); 243 return "not a rpm (bad header magic)" unless $headmagic == 0x8eade801; 244 $hlen = 16 + $cnt * 16; 245 while (length($buf) < $hlen) { 246 $l = sysread(F, $buf, defined($ml) && $ml < 4096 ? $ml : 4096, length($buf)); 247 return "read error" unless $l; 248 $ml -= $l if defined $ml; 249 } 250 my ($nameoff, $archoff, $btoff); 251 $idxarea = substr($buf, 0, $hlen); 252 my $srctype = ''; 253 if (!($idxarea =~ /\A(?:.{16})*\000\000\004\024/s)) { 254 if (($idxarea =~ /\A(?:.{16})*\000\000\004[\033\034]/s)) { 255 $srctype = 'nosrc'; 256 } else { 257 $srctype = 'src'; 258 } 259 } 260 if (($idxarea =~ /\A(?:.{16})*\000\000\003\350\000\000\000\006(....)\000\000\000\001/s)) { 261 $nameoff = unpack('N', $1); 262 } 263 if (($idxarea =~ /\A(?:.{16})*\000\000\003\376\000\000\000\006(....)\000\000\000\001/s)) { 264 $archoff = unpack('N', $1); 265 } 266 if (($idxarea =~ /\A(?:.{16})*\000\000\003\356\000\000\000\004(....)\000\000\000\001/s)) { 267 $btoff = unpack('N', $1); 268 } 269 return "rpm contains no name tag" unless defined $nameoff; 270 return "rpm contains no arch tag" unless defined $archoff; 271 return "rpm contains no build time" unless defined $btoff; 272 return "bad name/arch offset" if $nameoff >= $cntdata || $archoff >= $cntdata || $btoff + 3 >= $cntdata; 273 $ctx->add(substr($buf, 0, $hlen)) if $verify; 274 return "write error" if $wri && (syswrite(WF, substr($buf, 0, $hlen)) || 0) != $hlen; 275 $buf = substr($buf, $hlen); 276 my $maxoff = $nameoff > $archoff ? $nameoff : $archoff; 277 $maxoff += 1024; # should be enough 278 $maxoff = $btoff + 4 if $btoff + 4 > $maxoff; 279 $maxoff = $cntdata if $maxoff > $cntdata; 280 while (length($buf) < $maxoff) { 281 $l = sysread(F, $buf, defined($ml) && $ml < 4096 ? $ml : 4096, length($buf)); 282 return "read error" unless $l; 283 $ml -= $l if defined $ml; 284 } 285 my $name = unpack("\@${nameoff}Z*", $buf); 286 my $arch = unpack("\@${archoff}Z*", $buf); 287 my $bt = unpack("\@${btoff}H8", $buf); 288 if ($verify || $wri) { 289 $ctx->add($buf) if $verify; 290 return "write error" if $wri && (syswrite(WF, $buf) || 0) != length($buf); 291 while(1) { 292 last if defined($ml) && $ml == 0; 293 $l = sysread(F, $buf, defined($ml) && $ml < 8192 ? $ml : 8192); 294 last if !$l && !defined($ml); 295 return "read error" unless $l; 296 $ml -= $l if defined $ml; 297 $ctx->add($buf) if $verify; 298 return "write error" if $wri && (syswrite(WF, $buf) || 0) != $l; 299 } 300 if ($verify) { 301 my $rmd5 = $ctx->hexdigest; 302 return "rpm checksum error ($rmd5 != $hmd5)" if $rmd5 ne $hmd5; 303 } 304 } 305 $name = "unknown" if $name =~ /[\000-\040\/]/; 306 $arch = "unknown" if $arch =~ /[\000-\040\/]/; 307 $arch = $srctype if $srctype; 308 return ("$lmd5$hmd5", $bt, "$name.$arch"); 309} 310 311sub cpfile { 312 local *F = shift; 313 my ($wri) = @_; 314 315 local *WF; 316 *WF = $wri if $wri; 317 my $ctx; 318 $ctx = Digest::MD5->new; 319 my ($buf, $l); 320 while(1) { 321 $l = sysread(F, $buf, 8192); 322 last if !$l; 323 die("cpfile read error\n") unless $l; 324 $ctx->add($buf); 325 die("cpfile write error\n") if $wri && (syswrite(WF, $buf) || 0) != $l; 326 } 327 return ($ctx->hexdigest); 328} 329 330sub rpminfo_f { 331 my ($fd, $rpm) = @_; 332 my @info = cprpm($fd); 333 if (@info == 1) { 334 warn("$rpm: $info[0]\n"); 335 return (); 336 } 337 return @info; 338} 339 340sub rpminfo { 341 my $rpm = shift; 342 local *RPM; 343 if (!open(RPM, '<', $rpm)) { 344 warn("$rpm: $!\n"); 345 return (); 346 } 347 my @ret = rpminfo_f(*RPM, $rpm); 348 close RPM; 349 return @ret; 350} 351 352sub fileinfo_f { 353 local (*F) = shift; 354 355 my $ctx = Digest::MD5->new; 356 $ctx->addfile(*F); 357 return $ctx->hexdigest; 358} 359 360sub fileinfo { 361 my $fn = shift; 362 local *FN; 363 if (!open(FN, '<', $fn)) { 364 warn("$fn: $!\n"); 365 return (); 366 } 367 my @ret = fileinfo_f(*FN, $fn); 368 close FN; 369 return @ret; 370} 371 372sub linkinfo { 373 my $fn = shift; 374 my $fnc = readlink($fn); 375 if (!defined($fnc)) { 376 warn("$fn: $!\n"); 377 return (); 378 } 379 return Digest::MD5::md5_hex($fnc); 380} 381 382my @filter_comp; 383my @filter_arch_comp; 384 385sub run_filter { 386 my @x = @_; 387 388 my @f = @filter_comp; 389 my @r; 390 while (@f) { 391 my ($ft, $fre) = splice(@f, 0, 3); 392 my @xx = grep {/$fre/} @x; 393 my %xx = map {$_ => 1} @xx; 394 push @r, @xx if $ft; 395 @x = grep {!$xx{$_}} @x; 396 } 397 return (@r, @x); 398} 399 400sub run_filter_one { 401 my ($n) = @_; 402 my @f = @filter_comp; 403 while (@f) { 404 my ($ft, $fre) = splice(@f, 0, 3); 405 if ($ft) { 406 return 1 if $n =~ /$fre/; 407 } else { 408 return if $n =~ /$fre/; 409 } 410 } 411 return 1; 412} 413 414sub compile_filter { 415 my @rules = @_; 416 417 my @comp = (); 418 for my $rule (@rules) { 419 die("bad filter type, must be '+' or '-'\n") unless $rule =~ /^([+-])(.*)$/; 420 my $type = $1 eq '+' ? 1 : 0; 421 my $match = $2; 422 my $anchored = $match =~ s/^\///; 423 my @match = split(/\[(\^?.(?:\\.|[^]])*)\]/, $match, -1); 424 my $i = 0; 425 for (@match) { 426 $i = 1 - $i; 427 if (!$i) { 428 s/([^-\^a-zA-Z0-9])/\\$1/g; 429 s/\\\\(\\[]\\\]]|-)/"\\".substr($1, -1)/ge; 430 $_ = "[$_]"; 431 next; 432 } 433 $_ = "\Q$_\E"; 434 s/\\\*\\\*/.*/g; 435 s/\\\*/[^\/]*/g; 436 s/\\\?/[^\/]/g; 437 } 438 $match = join('', @match); 439 if ($anchored) { 440 $match = "^$match"; 441 } else { 442 $match = "(?:^|\/)$match"; 443 } 444 $match .= '\/?' if $match !~ /\/$/; 445 $match .= '$'; 446 eval { 447 push @comp, $type, qr/$match/s, $rule; 448 }; 449 die("bad filter rule: $rule\n") if $@; 450 } 451 return @comp; 452} 453 454sub filelist_apply_filter { 455 my ($flp) = @_; 456 return unless @filter_comp; 457 my @ns = (); 458 my $x; 459 for my $e (@$flp) { 460 if (defined($x)) { 461 next if substr($e->[0], 0, length($x)) eq $x; 462 undef $x; 463 } 464 if (@$e == 3) { 465 if (!run_filter_one("$e->[0]/")) { 466 $x = "$e->[0]/"; 467 next; 468 } 469 } else { 470 next if !run_filter_one("$e->[0]"); 471 } 472 push @ns, $e; 473 } 474 @$flp = @ns; 475} 476 477sub filelist_apply_filter_arch { 478 my ($flp) = @_; 479 return unless @filter_arch_comp; 480 my %filtered; 481 my @filter_comp_save = @filter_comp; 482 @filter_comp = @filter_arch_comp; 483 my @ns = (); 484 for my $e (@$flp) { 485 if (@$e > 5 && !run_filter_one((split('\.', $e->[5]))[-1])) { 486 if ($e->[0] =~ /(.*)\.rpm$/) { 487 $filtered{"$1.changes"} = 1; 488 $filtered{"$1-MD5SUMS.meta"} = 1; 489 $filtered{"$1-MD5SUMS.srcdir"} = 1; 490 } 491 next; 492 } 493 push @ns, $e; 494 } 495 @filter_comp = @filter_comp_save; 496 @$flp = @ns; 497 if (%filtered) { 498 # second pass to remove meta files 499 @ns = (); 500 for my $e (@$flp) { 501 next if @$e == 4 && $filtered{$e->[0]}; 502 push @ns, $e; 503 } 504 @$flp = @ns; 505 } 506} 507 508sub filelist_exclude_drpmsync { 509 my ($flp) = @_; 510 @$flp = grep {$_->[0] =~ /(?:^|\/)drpmsync\//s || (@$_ == 3 && $_->[0] =~ /(?:^|\/)drpmsync$/s)} @$flp; 511} 512 513my @files; 514my %cache; 515my $cachehits = 0; 516my $cachemisses = 0; 517 518sub findfiles { 519 my ($bdir, $dir, $keepdrpmdir, $norecurse) = @_; 520 521 local *DH; 522 if (!opendir(DH, "$bdir$dir")) { 523 warn("$dir: $!\n"); 524 return; 525 } 526 my @ents = sort readdir(DH); 527 closedir(DH); 528 $bdir .= '/' if $dir eq ''; 529 $dir .= '/' if $dir ne ''; 530 if ($dir ne '' && grep {$_ eq 'drpmsync'} @ents) { 531 readcache("$bdir${dir}drpmsync/cache") if -f "$bdir${dir}drpmsync/cache"; 532 } 533 my %fents; 534 if (@filter_comp) { 535 @ents = grep {$_ ne '.' && $_ ne '..'} @ents; 536 my @fents = run_filter(map {"$dir$_"} @ents); 537 if (@fents != @ents) { 538 %fents = map {("$dir$_" => 1)} @ents; 539 delete $fents{$_} for @fents; 540 } 541 } 542 for my $ent (@ents) { 543 next if $ent eq '.' || $ent eq '..'; 544 next if $ent =~ /\.new\d*$/; 545 my @s = lstat "$bdir$dir$ent"; 546 if (!@s) { 547 warn("$bdir$dir$ent: $!\n"); 548 next; 549 } 550 next unless -l _ || -d _ || -f _; 551 my $id = "$s[9]/$s[7]/$s[1]"; 552 my $mode = -l _ ? 0x2000 : -f _ ? 0x1000 : 0x0000; 553 $mode |= $s[2] & 07777; 554 my @data = ($id, sprintf("%04x%08x", $mode, $s[9])); 555 if (-d _) { 556 next if $ent eq 'drpmsync' && ($dir eq '' || !$keepdrpmdir); 557 next if @filter_comp && !run_filter_one("$dir$ent/"); 558 push @files, [ "$dir$ent", @data ]; 559 next if $norecurse; 560 findfiles($bdir, "$dir$ent", $keepdrpmdir); 561 } else { 562 next if @filter_comp && $fents{"$dir$ent"}; 563 my @xdata; 564 if ($cache{$id}) { 565 @xdata = @{$cache{$id}}; 566 if (@xdata == ($ent =~ /\.[sr]pm$/) ? 3 : 1) { 567 $cachehits++; 568 push @files, [ "$dir$ent", @data, @xdata ]; 569 next; 570 } 571 } 572 # print "miss $id ($ent)\n"; 573 $cachemisses++; 574 if (-l _) { 575 @xdata = linkinfo("$bdir$dir$ent"); 576 next if !@xdata; 577 $cache{$id} = \@xdata; 578 push @files, [ "$dir$ent", @data, @xdata ]; 579 next; 580 } 581 local *F; 582 if (!open(F, '<', "$bdir$dir$ent")) { 583 warn("$bdir$dir$ent: $!\n"); 584 next; 585 } 586 @s = stat F; 587 if (!@s || ! -f _) { 588 warn("$bdir$dir$ent: $!\n"); 589 next; 590 } 591 $id = "$s[9]/$s[7]/$s[1]"; 592 @data = ($id, sprintf("1%03x%08x", ($s[2] & 07777), $s[9])); 593 if ($ent =~ /\.[sr]pm$/) { 594 @xdata = rpminfo_f(*F, "$bdir$dir$ent"); 595 } else { 596 @xdata = fileinfo_f(*F, "$bdir$dir$ent"); 597 } 598 close F; 599 next if !@xdata; 600 $cache{$id} = \@xdata; 601 push @files, [ "$dir$ent", @data, @xdata ]; 602 } 603 } 604} 605 606sub readcache { 607 my $cf = shift; 608 609 local *CF; 610 open(CF, '<', $cf) || return; 611 while(<CF>) { 612 chomp; 613 my @s = split(' '); 614 next unless @s == 4 || @s == 2; 615 my $s = shift @s; 616 $cache{$s} = \@s; 617 } 618 close CF; 619} 620 621sub writecache { 622 my $cf = shift; 623 624 local *CF; 625 open(CF, '>', "$cf.new") || die("$cf.new: $!\n"); 626 for (@files) { 627 next if @$_ < 4; # no need to cache dirs 628 if (@$_ > 5) { 629 print CF "$_->[1] $_->[3] $_->[4] $_->[5]\n"; 630 } else { 631 print CF "$_->[1] $_->[3]\n"; 632 } 633 } 634 close CF; 635 rename("$cf.new", $cf) || die("rename $cf.new $cf: $!\n"); 636} 637 638####################################################################### 639# Server stuff 640####################################################################### 641 642sub escape { 643 my $x = shift; 644 $x =~ s/\&/&/g; 645 $x =~ s/\</</g; 646 $x =~ s/\>/>/g; 647 $x =~ s/\"/"/g; 648 return $x; 649} 650 651sub aescape { 652 my $x = shift; 653 $x =~ s/([\000-\040<>\"#&\+=%[\177-\377])/sprintf("%%%02X",ord($1))/ge; 654 return $x; 655} 656 657sub readfile { 658 my $fn = shift; 659 local *FN; 660 open(FN, '<', $fn) || return ('', "$fn: $!"); 661 my $out = ''; 662 while ((sysread(FN, $out, 8192, length($out)) || 0) == 8192) {} 663 close FN; 664 return ($out, ''); 665} 666 667# server config 668my %trees; 669my %chld; 670my $standalone; 671my $sendlogid; 672my $servername; 673my $serveraddr; 674my $serveruser; 675my $servergroup; 676my $serverlog; 677my $maxclients = 10; 678my $servertmp = '/var/tmp'; 679my $serverpidfile; 680 681sub readconfig_server { 682 my $cf = shift; 683 684 my @allow; 685 my @deny; 686 my $no_combine; 687 my $log; 688 my $slog; 689 my $deltadirs; 690 my $maxdeltasize; 691 my $maxdeltasizeabs; 692 my @denymsg; 693 local *CF; 694 die("config not set\n") unless $cf; 695 open(CF, '<', $cf) || die("$cf: $!\n"); 696 while(<CF>) { 697 chomp; 698 s/^\s+//; 699 s/\s+$//; 700 next if $_ eq '' || /^#/; 701 my @s = split(' ', $_); 702 my $s0 = lc($s[0]); 703 $s0 =~ s/:$//; 704 my $s1 = @s > 1 ? $s[1] : undef; 705 shift @s; 706 if ($s0 eq 'allow' || $s0 eq 'deny') { 707 for (@s) { 708 if (/^\/(.*)\/$/) { 709 $_ = $1; 710 eval { local $::SIG{'__DIE__'}; "" =~ /^$_$/; }; 711 die("$s0: bad regexp: $_\n") if $@; 712 } else { 713 s/([^a-zA-Z0-9*])/\\$1/g; 714 s/\*/.*/g; 715 } 716 } 717 if ($s0 eq 'allow') { 718 @allow = @s; 719 } else { 720 @deny = @s; 721 } 722 } elsif ($s0 eq 'denymsg') { 723 if (!@s) { 724 @denymsg = (); 725 next; 726 } 727 if ($s1 =~ /^\/(.*)\/$/) { 728 $s1 = $1; 729 eval { local $::SIG{'__DIE__'}; "" =~ /^$s1$/; }; 730 die("$s0: bad regexp: $s1\n") if $@; 731 } else { 732 $s1 =~ s/([^a-zA-Z0-9*])/\\$1/g; 733 $s1 =~ s/\*/.*/g; 734 } 735 shift @s; 736 push @denymsg, [ $s1, join(' ', @s) ]; 737 } elsif ($s0 eq 'no_combine') { 738 $no_combine = ($s1 && $s1 =~ /true/i); 739 } elsif ($s0 eq 'log') { 740 $log = $s1; 741 } elsif ($s0 eq 'serverlog') { 742 $slog = $s1; 743 } elsif ($s0 eq 'deltadirs') { 744 $deltadirs = $s1; 745 } elsif ($s0 eq 'deltarpmpath') { 746 my $p = defined($s1) ? "$s1/" : ''; 747 $makedeltarpm = "${p}makedeltarpm"; 748 $combinedeltarpm = "${p}combinedeltarpm"; 749 $fragiso = "${p}fragiso"; 750 } elsif ($s0 eq 'maxclients') { 751 $maxclients = $s1 || 1; 752 } elsif ($s0 eq 'servername') { 753 $servername = $s1; 754 } elsif ($s0 eq 'serveraddr') { 755 $serveraddr = $s1; 756 } elsif ($s0 eq 'serveruser') { 757 $serveruser = $s1; 758 } elsif ($s0 eq 'servergroup') { 759 $servergroup = $s1; 760 } elsif ($s0 eq 'pidfile') { 761 $serverpidfile = $s1; 762 } elsif ($s0 eq 'maxdeltasize') { 763 $maxdeltasize = $s1; 764 } elsif ($s0 eq 'maxdeltasizeabs') { 765 $maxdeltasizeabs = $s1; 766 } elsif ($s0 eq 'tree') { 767 die("tree: two arguments required\n") if @s != 2; 768 $trees{$s[0]} = { 'allow' => [ @allow ], 769 'deny' => [ @deny ], 770 'denymsg' => [ @denymsg ], 771 'no_combine' => $no_combine, 772 'maxdeltasize' => $maxdeltasize, 773 'maxdeltasizeabs' => $maxdeltasizeabs, 774 'deltadirs' => $deltadirs, 775 'log' => $log, 776 'root' => $s[1], 777 'id' => $s[0] 778 }; 779 } else { 780 die("$cf: unknown configuration parameter: $s0\n"); 781 } 782 } 783 close CF; 784 $serverlog = $slog; 785} 786 787sub gethead { 788 my $h = shift; 789 my $t = shift; 790 791 my ($field, $data); 792 $field = undef; 793 for (split(/[\r\n]+/, $t)) { 794 next if $_ eq ''; 795 if (/^[ \t]/) { 796 next unless defined $field; 797 s/^\s*/ /; 798 $h->{$field} .= $_; 799 } else { 800 ($field, $data) = split(/\s*:\s*/, $_, 2); 801 $field =~ tr/A-Z/a-z/; 802 if ($h->{$field} && $h->{$field} ne '') { 803 $h->{$field} = $h->{$field}.','.$data; 804 } else { 805 $h->{$field} = $data; 806 } 807 } 808 } 809} 810 811sub serverlog { 812 my $id = shift; 813 my $str = shift; 814 return unless $serverlog; 815 $str =~ s/\n$//s; 816 my @lt = localtime(time()); 817 $lt[5] += 1900; 818 $lt[4] += 1; 819 $id = defined($id) ? " [$id]" : ''; 820 printf SERVERLOG "%04d-%02d-%02d %02d:%02d:%02d%s: %s\n", @lt[5,4,3,2,1,0], $id, $str; 821} 822 823sub serverdetach { 824 my $pid; 825 local (*SR, *SW); 826 pipe(SR, SW) || die("setsid pipe: $!\n"); 827 while (1) { 828 $pid = fork(); 829 last if defined $pid; 830 die("fork: $!") if $! != POSIX::EAGAIN; 831 sleep(5); 832 } 833 if ($pid) { 834 close SW; 835 my $dummy = ''; 836 sysread(SR, $dummy, 1); 837 exit(0); 838 } 839 POSIX::setsid(); 840 close SW; 841 close SR; 842 open(STDIN, "</dev/null"); 843 open(STDOUT, ">/dev/null"); 844 open(STDERR, ">/dev/null"); 845} 846 847sub startserver { 848 my $config = shift; 849 my $nobg = shift; 850 851 # not called from web server, go for standalone 852 $standalone = 1; 853 readconfig_server($config); 854 unlink($serverpidfile) if $serverpidfile; 855 if ($serverlog && !open(SERVERLOG, '>>', $serverlog)) { 856 my $err = "$serverlog: $!\n"; 857 undef $serverlog; # do not log in die() hook 858 die($err); 859 } 860 serverlog(undef, "server start"); 861 $servername = '' unless defined $servername; 862 $servername = Net::Domain::hostfqdn().$servername if $servername eq '' || $servername =~ /^:\d+$/; 863 die("need servername for standalone mode\n") unless $servername; 864 if (defined($serveruser) && $serveruser =~ /[^\d]/) { 865 my $uid = getpwnam($serveruser); 866 die("$serveruser: unknown user\n") unless defined $uid; 867 $serveruser = $uid; 868 } 869 if (defined($servergroup) && $servergroup =~ /[^\d]/) { 870 my $gid = getgrnam($servergroup); 871 die("$servergroup: unknown group\n") unless defined $gid; 872 $servergroup = $gid; 873 } 874 my ($servern, $servera, $serverp); 875 ($servern, $serverp) = $servername =~ /^([^\/]+?)(?::(\d+))?$/; 876 die("bad servername: $servername\n") unless $servern; 877 $serverp ||= 80; 878 $servera = INADDR_ANY; 879 if ($serveraddr) { 880 $servera = inet_aton($serveraddr) || die("could not resolv $serveraddr\n"); 881 } 882 my $tcpproto = getprotobyname('tcp'); 883 socket(MS , PF_INET, SOCK_STREAM, $tcpproto) || die("socket: $!\n"); 884 setsockopt(MS, SOL_SOCKET, SO_REUSEADDR, pack("l",1)); 885 bind(MS, sockaddr_in($serverp, $servera)) || die "bind: $!\n"; 886 listen(MS , 512) || die "listen: $!\n"; 887 888 local *SERVERPID; 889 if ($serverpidfile) { 890 open(SERVERPID, '>', $serverpidfile) || die("$serverpidfile: $!\n"); 891 } 892 893 if (defined($servergroup)) { 894 ($(, $)) = ($servergroup, $servergroup); 895 die "setgid: $!\n" if $) != $servergroup; 896 } 897 if (defined($serveruser)) { 898 ($<, $>) = ($serveruser, $serveruser); 899 die "setuid: $!\n" if $> != $serveruser; 900 } 901 serverdetach() unless $nobg; 902 903 if ($serverpidfile) { 904 syswrite(SERVERPID, "$$\n"); 905 close(SERVERPID) || die("$serverpidfile: $!\n"); 906 } 907 908 fcntl(MS, F_SETFL, 0); 909 my $remote_addr; 910 while (1) { 911 $remote_addr = accept(S, MS) || die "accept: $!\n"; 912 my $pid; 913 while (1) { 914 $pid = fork(); 915 last if defined($pid); 916 sleep(5); 917 } 918 last if $pid == 0; 919 close(S); 920 $chld{$pid} = 1; 921 $remote_addr = inet_ntoa((sockaddr_in($remote_addr))[1]); 922 while(1) { 923 $pid = waitpid(-1, keys %chld < $maxclients ? WNOHANG : 0); 924 delete $chld{$pid} if $pid && $pid > 0; 925 last if !($pid && $pid > 0) && keys %chld < $maxclients; 926 } 927 } 928 close MS; 929 $standalone = 2; 930 setsockopt(S, SOL_SOCKET, SO_KEEPALIVE, pack("l",1)); 931 $remote_addr = inet_ntoa((sockaddr_in($remote_addr))[1]); 932 return $remote_addr; 933} 934 935sub parse_cgi { 936 my ($cgip, $query_string) = @_; 937 938 %$cgip = (); 939 my @query_string = split('&', $query_string); 940 while (@query_string) { 941 my ($name, $value) = split('=', shift(@query_string), 2); 942 next unless defined $name && $name ne ''; 943 $name =~ tr/+/ /; 944 $name =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/ge; 945 if (defined($value)) { 946 $value =~ tr/+/ /; 947 $value =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/ge; 948 } 949 if ($name eq 'filter' || $name eq 'filter_arch') { 950 push @{$cgip->{$name}}, $value; 951 } else { 952 $cgip->{$name} = $value; 953 } 954 } 955} 956 957sub getrequest { 958 my $qu = ''; 959 do { 960 die($qu eq '' ? "empty query\n" : "received truncated query\n") if !sysread(S, $qu, 1024, length($qu)); 961 } while ($qu !~ /^(.*?)\r?\n/s); 962 my $req = $1; 963 my ($act, $path, $vers, undef) = split(' ', $req, 4); 964 my %headers; 965 die("400 No method name\n") if !$act; 966 if ($vers ne '') { 967 die("501 Bad method: $act\n") if $act ne 'GET' && $act ne 'HEAD' && $act ne 'POST'; 968 while ($qu !~ /^(.*?)\r?\n\r?\n(.*)$/s) { 969 die("received truncated query\n") if !sysread(S, $qu, 1024, length($qu)); 970 } 971 $qu =~ /^(.*?)\r?\n\r?\n(.*)$/s; 972 $qu = $2; 973 gethead(\%headers, "Request: $1"); 974 } elsif ($act ne 'GET') { 975 die("501 Bad method, must be GET\n"); 976 $qu = ''; 977 } 978 my $query_string = ''; 979 if ($path =~ /^(.*?)\?(.*)$/) { 980 $path = $1; 981 $query_string = $2; 982 } 983 if ($act eq 'POST') { 984 $query_string = ''; 985 my $cl = $headers{'content-length'}; 986 while (length($qu) < $cl) { 987 sysread(S, $qu, $cl - length($qu), length($qu)) || die("400 Truncated body\n"); 988 } 989 $query_string = substr($qu, 0, $cl); 990 $qu = substr($qu, $cl); 991 } 992 $path =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/ge; 993 return ($path, $query_string, $headers{'via'} ? 1 : 0); 994} 995 996sub replystream { 997 local (*FF) = shift; 998 my ($flen, $str, $ctx, @hi) = @_; 999 die("replystream: bad param\n") unless $flen; 1000 unshift @hi, "HTTP/1.1 200 OK"; 1001 push @hi, "Server: drpmsync"; 1002 push @hi, "Cache-Control: no-cache"; 1003 push @hi, "Content-length: ".(length($str) + $flen + 32); 1004 $str = join("\r\n", @hi)."\r\n\r\n".$str; 1005 if ($standalone) { 1006 fcntl(S, F_SETFL,O_NONBLOCK); 1007 my $dummy = ''; 1008 1 while sysread(S, $dummy, 1024, 0); 1009 fcntl(S, F_SETFL,0); 1010 } 1011 my $r; 1012 while (length($str) || $flen) { 1013 if ($flen && length($str) < 16384) { 1014 my $d; 1015 my $r = sysread(FF, $d, $flen > 8192 ? 8192 : $flen); 1016 if (!$r) { 1017 die("replystream: read error: $!\n") unless defined $r; 1018 die("replystream: unexpected EOF\n"); 1019 } 1020 die("replystream: too much data\n") if $r > $flen; 1021 $ctx->add($d); 1022 $str .= $d; 1023 $flen -= $r; 1024 $str .= $ctx->hexdigest if !$flen; 1025 } 1026 $r = syswrite(S, $str, length($str)); 1027 die("replystream: write error: $!\n") unless $r; 1028 $str = substr($str, $r); 1029 } 1030} 1031 1032sub reply { 1033 my ($str, @hi) = @_; 1034 1035 if ($standalone) { 1036 if (@hi && $hi[0] =~ /^status: (\d+.*)/i) { 1037 $hi[0] = "HTTP/1.1 $1"; 1038 } else { 1039 unshift @hi, "HTTP/1.1 200 OK"; 1040 } 1041 } 1042 push @hi, "Server: drpmsync"; 1043 push @hi, "Cache-Control: no-cache"; 1044 push @hi, "Content-length: ".length($str); 1045 $str = join("\r\n", @hi)."\r\n\r\n$str"; 1046 if (!$standalone) { 1047 print $str; 1048 return; 1049 } 1050 fcntl(S, F_SETFL,O_NONBLOCK); 1051 my $dummy = ''; 1052 1 while sysread(S, $dummy, 1024, 0); 1053 fcntl(S, F_SETFL,0); 1054 my $l; 1055 while (length($str)) { 1056 $l = syswrite(S, $str, length($str)); 1057 die("write error: $!\n") unless $l; 1058 $str = substr($str, $l); 1059 } 1060} 1061 1062sub reply_err { 1063 my ($err, $cgi, $remote_addr) = @_; 1064 serverlog($remote_addr, $err) if $serverlog && !$sendlogid; 1065 sendlog($err) if $sendlogid; 1066 die($err) if $standalone == 1; 1067 $err =~ s/\n$//s; 1068 if (exists($cgi->{'drpmsync'})) { 1069 my $data = 'DRPMSYNC0001ERR 00000000'.sprintf("%08x", length($err)).$err; 1070 reply($data, "Content-type: application/octet-stream"); 1071 } elsif ($err =~ /^(\d+[^\r\n]*)/) { 1072 reply("<pre>$err</pre>\n", "Status: $1", "Content-type: text/html"); 1073 } else { 1074 reply("<pre>$err</pre>\n", "Status: 404 Error", "Content-type: text/html"); 1075 } 1076 exit(0); 1077} 1078 1079my $check_access_cache_addr; 1080my $check_access_cache_name; 1081 1082sub check_access { 1083 my ($tree, $remote_addr) = @_; 1084 my ($remote_name, $access_ok); 1085 1086 $remote_name = $check_access_cache_name if $check_access_cache_addr && $check_access_cache_addr eq $remote_addr; 1087 1088 if (@{$tree->{'deny'}}) { 1089 if (!$remote_name) { 1090 $remote_name = gethostbyaddr(inet_aton($remote_addr), AF_INET); 1091 die("could not resolve $remote_addr\n") unless $remote_name; 1092 $check_access_cache_addr = $remote_addr; 1093 $check_access_cache_name = $remote_name; 1094 } 1095 for my $deny (@{$tree->{'deny'}}) { 1096 if ($deny =~ /^!/) { 1097 my $d1 = substr($deny, 1); 1098 last if $remote_name =~ /^$d1$/i; 1099 last if $remote_addr =~ /^$d1$/i; 1100 } 1101 goto denied if $remote_name =~ /^$deny$/i; 1102 goto denied if $remote_addr =~ /^$deny$/i; 1103 } 1104 } 1105 for my $allow (@{$tree->{'allow'}}) { 1106 last if $allow =~ /^!/; 1107 return if $remote_addr =~ /^$allow$/i; 1108 } 1109 if (!$remote_name) { 1110 $remote_name = gethostbyaddr(inet_aton($remote_addr), AF_INET); 1111 die("could not resolve $remote_addr\n") unless $remote_name; 1112 $check_access_cache_addr = $remote_addr; 1113 $check_access_cache_name = $remote_name; 1114 } 1115 for my $allow (@{$tree->{'allow'}}) { 1116 if ($allow =~ /^!/) { 1117 my $a1 = substr($allow, 1); 1118 last if $remote_name =~ /^$a1$/i; 1119 last if $remote_addr =~ /^$a1$/i; 1120 } 1121 return if $remote_addr =~ /^$allow$/i; 1122 return if $remote_name =~ /^$allow$/i; 1123 } 1124denied: 1125 my $denymsg = "access denied [%h]"; 1126 for my $dmsg (@{$tree->{'denymsg'}}) { 1127 if ($remote_name =~ /^$dmsg->[0]$/i || $remote_addr =~ /^$dmsg->[0]$/i) { 1128 $denymsg = $dmsg->[1]; 1129 last; 1130 } 1131 } 1132 $denymsg =~ s/%h/$remote_addr/g; 1133 $denymsg =~ s/%n/$remote_name/g; 1134 die("$denymsg\n"); 1135} 1136 1137sub sendlog { 1138 my $str = shift; 1139 return unless $sendlogid; 1140 $str =~ s/\n$//s; 1141 my @lt = localtime(time()); 1142 $lt[5] += 1900; 1143 $lt[4] += 1; 1144 printf SENDLOG "%05d %04d-%02d-%02d %02d:%02d:%02d %s: %s\n", $$, @lt[5,4,3,2,1,0], $sendlogid, $str; 1145} 1146 1147sub solve { 1148 my ($have2, $info2, @dirs) = @_; 1149 1150 my @avail; 1151 for my $dir (@dirs) { 1152 if (opendir(D, $dir)) { 1153 push @avail, map {"$dir/$_"} grep {/^[0-9a-f]{96}$/} readdir(D); 1154 closedir D; 1155 } 1156 } 1157 return () unless @avail; 1158 my $gotone; 1159 for (@avail) { 1160 if ($have2->{substr($_, -96, 32)}) { 1161 $gotone = 1; 1162 last; 1163 } 1164 } 1165 return () unless $gotone; 1166 my @chains = ([$info2]); 1167 my %avail; 1168 push @{$avail{substr($_, -32, 32)}}, $_ for @avail; 1169 while (@chains && @{$chains[0]} <= @avail) { 1170 for my $pos (splice @chains) { 1171 for my $a (@{$avail{$pos->[0]}}) { 1172 my @n = (@$pos, $a); 1173 $n[0] = substr($a, -96, 32); 1174 if ($have2->{$n[0]}) { 1175 shift @n; 1176 return reverse @n; 1177 } 1178 push @chains, \@n; 1179 } 1180 } 1181 } 1182 return (); 1183} 1184 1185sub extractrpm { 1186 local *F = shift; 1187 my ($o, $l) = @_; 1188 local *F2; 1189 tmpopen(*F2, $servertmp); 1190 defined(sysseek(F, $o, 0)) || die("extractrpm: sysseek: $!\n"); 1191 my $buf; 1192 while ($l > 0) { 1193 my $r = sysread(F, $buf, $l > 8192 ? 8192 : $l); 1194 if (!$r) { 1195 die("extractrpm: read error: $!\n") unless defined $r; 1196 die("extractrpm: unexpected EOF\n"); 1197 } 1198 die("extractrpm: read too much data\n") if $r > $l; 1199 die("extractrpm: write error: $!\n") if (syswrite(F2, $buf) || 0) != $r; 1200 $l -= $r; 1201 } 1202 close(F); 1203 seek(F2, 0, 0); 1204 sysseek(F2, 0, 0); 1205 open(F, "<&F2") || die("extractrpm: dup: $!\n"); 1206 close(F2); 1207} 1208 1209sub hexit { 1210 my $v = shift; 1211 if ($v >= 4294967295) { 1212 my $v2 = int($v / 4294967296); 1213 return sprintf("FFFFFFFF%02x%08x", $v2, $v - 4294967296 * $v2); 1214 } else { 1215 return sprintf("%08x", $v); 1216 } 1217} 1218 1219my $deltadirscache; 1220my $deltadirscacheid; 1221 1222sub getdeltadirs { 1223 my ($ddconfig, $path) = @_; 1224 1225 my @dirs; 1226 if ($deltadirscache) { 1227 my @ddstat = stat($ddconfig); 1228 undef $deltadirscache if !@ddstat || "$ddstat[9]/$ddstat[7]/$ddstat[1]" ne $deltadirscacheid; 1229 } 1230 if (!$deltadirscache) { 1231 local *DD; 1232 my @ddc; 1233 if (open(DD, '<', $ddconfig)) { 1234 while(<DD>) { 1235 chomp; 1236 next if /^\s*$/; 1237 if (@ddc && /^\s*\+\s*(.*)/) { 1238 push @{$ddc[-1]}, split(' ', $1); 1239 } else { 1240 push @ddc, [ split(' ', $_) ]; 1241 } 1242 } 1243 my @ddstat = stat(DD); 1244 close DD; 1245 $deltadirscache = \@ddc; 1246 $deltadirscacheid = "$ddstat[9]/$ddstat[7]/$ddstat[1]"; 1247 } 1248 } 1249 if ($deltadirscache) { 1250 for my $dd (@$deltadirscache) { 1251 my @dd = @$dd; 1252 my $ddre = shift @dd; 1253 eval { 1254 push @dirs, @dd if $path =~ /$ddre/; 1255 }; 1256 } 1257 } 1258 return @dirs; 1259} 1260 1261sub serve_request { 1262 my ($cgi, $path_info, $script_name, $remote_addr, $keep_ok) = @_; 1263 1264 my $tree; 1265 $path_info = '' unless defined $path_info; 1266 die("invalid path\n") if $path_info =~ /\/(\.|\.\.)?\//; 1267 die("invalid path\n") if $path_info =~ /\/(\.|\.\.)$/; 1268 die("invalid path\n") if "$path_info/" =~ /(\.|\.\.)\//; 1269 die("invalid path\n") if $path_info ne '' && ($path_info !~ /^\//); 1270 die("$script_name not exported\n") unless $trees{$script_name}; 1271 1272 my $sendlog = $trees{$script_name}->{'log'}; 1273 if ($tree && $tree->{'log'} && (!$sendlog || $tree->{'log'} ne $sendlog)) { 1274 close(SENDLOG); 1275 undef $sendlogid; 1276 } 1277 if ($sendlog && (!$tree || !$tree->{'log'} || $tree->{'log'} ne $sendlog)) { 1278 open(SENDLOG, '>>', $sendlog) || die("$sendlog: $!\n"); 1279 select(SENDLOG); 1280 $| = 1; 1281 select(STDOUT); 1282 $sendlogid = "[$remote_addr] $trees{$script_name}->{'id'}"; 1283 } 1284 $tree = $trees{$script_name}; 1285 check_access($tree, $remote_addr); 1286 1287 my $spath_info = $path_info; 1288 $spath_info =~ s/^\///; 1289 1290 my $root = $tree->{'root'}; 1291 die("$root: $!\n") unless -d $root; 1292 1293 my $replyid = $keep_ok ? 'DRPMSYNK' : 'DRPMSYNC'; 1294 1295 if ($path_info =~ /(.*)\/drpmsync\/closesock$/ && exists $cgi->{'drpmsync'}) { 1296 my $croot = $1; 1297 sendlog(". $croot bye"); 1298 close(S); 1299 exit(0); 1300 } 1301 1302 if ($path_info =~ /^(.*)\/drpmsync\/contents$/) { 1303 my $croot = $1; 1304 die("$croot: does not exist\n") unless -e "$root$croot"; 1305 die("$croot: not a directory\n") unless -d "$root$croot"; 1306 sendlog("# $croot contents request"); 1307 my $ti = time(); 1308 readcache("$root$croot/drpmsync/cache"); 1309 @files = (); 1310 $cachehits = $cachemisses = 0; 1311 @filter_comp = compile_filter(@{$cgi->{'filter'} || []}); 1312 @filter_arch_comp = compile_filter(@{$cgi->{'filter_arch'} || []}); 1313 findfiles("$root$croot", '', 0, exists($cgi->{'norecurse'}) ? 1 : 0); 1314 filelist_apply_filter_arch(\@files) if @filter_arch_comp; 1315 %cache = (); 1316 $ti = time() - $ti; 1317 my ($stamp1, $stamp2); 1318 $stamp1 = $stamp2 = sprintf("%08x", time()); 1319 if (open(STAMP, '<', "$root$croot/drpmsync/timestamp")) { 1320 my $s = ''; 1321 if ((sysread(STAMP, $s, 16) || 0) == 16 && $s !~ /[^0-9a-f]/) { 1322 $stamp1 = substr($s, 0, 8); 1323 $stamp2 = substr($s, 8, 8); 1324 } 1325 close STAMP; 1326 } 1327 my $data = ''; 1328 if (!exists $cgi->{'drpmsync'}) { 1329 for (@files) { 1330 my @l = @$_; 1331 $l[0] = aescape($l[0]); 1332 $l[5] = aescape($l[5]) if @l > 5; 1333 splice(@l, 1, 1); 1334 $data .= join(' ', @l)."\n"; 1335 } 1336 sendlog("h $croot contents ($cachehits/$cachemisses/$ti)"); 1337 reply($data, "Content-type: text/plain"); 1338 exit(0); 1339 } 1340 $data = pack('H*', "$stamp1$stamp2"); 1341 $data = pack("Nw/a*w/a*", scalar(@files), $tree->{'id'}, $data); 1342 for (@files) { 1343 my @l = @$_; 1344 my $b; 1345 if (@l > 5) { 1346 $b = pack('H*', "$l[2]$l[3]$l[4]").$l[5]; 1347 } elsif (@l > 3) { 1348 $b = pack('H*', "$l[2]$l[3]"); 1349 } else { 1350 $b = pack('H*', $l[2]); 1351 } 1352 $data .= pack("w/a*w/a*", $l[0], $b); 1353 } 1354 @files = (); 1355 my $dataid = 'SYNC'; 1356 if ($have_zlib && exists($cgi->{'zlib'})) { 1357 $data = Compress::Zlib::compress($data); 1358 $dataid = 'SYNZ'; 1359 sendlog("z $croot contents ($cachehits/$cachemisses/$ti)"); 1360 } else { 1361 sendlog("f $croot contents ($cachehits/$cachemisses/$ti)"); 1362 } 1363 $data = sprintf("1%03x%08x", 0644, time()).$data; 1364 $data = "${replyid}0001${dataid}00000000".sprintf("%08x", length($data)).$data.Digest::MD5::md5_hex($data); 1365 reply($data, "Content-type: application/octet-stream"); 1366 return; 1367 } 1368 1369 my @s = lstat("$root$path_info"); 1370 1371 if (!exists($cgi->{'drpmsync'})) { 1372 die("$spath_info: $!\n") unless @s; 1373 if (! -d _) { 1374 die("$spath_info: bad file type\n") unless -f _; 1375 sendlog("h $path_info"); 1376 open(F, '<', "$root$path_info") || die("$spath_info: $!\n"); 1377 my $c = ''; 1378 while ((sysread(F, $c, 4096, length($c)) || 0) == 4096) {} 1379 close F; 1380 my $ct = 'text/plain'; 1381 if ($spath_info =~ /\.(gz|rpm|spm|bz2|tar|tgz|jpg|jpeg|gif|png|pdf)$/) { 1382 $ct = 'application/octet-stream'; 1383 } 1384 reply($c, "Content-type: $ct"); 1385 exit(0); 1386 } 1387 if (($path_info !~ s/\/$//)) { 1388 if ($standalone) { 1389 reply("The document has moved", "Status: 302 Found", "Content-type: text/html", "Location: http://$servername$tree->{'id'}$path_info/"); 1390 } else { 1391 reply("The document has moved", "Status: 302 Found", "Content-type: text/html", "Location: http://$ENV{'SERVER_NAME'}$tree->{'id'}$path_info/"); 1392 } 1393 exit(0); 1394 } 1395 sendlog("h $path_info"); 1396 opendir(DIR, "$root$path_info") || die("$root$path_info: $!\n"); 1397 my @ents = sort readdir(DIR); 1398 closedir DIR; 1399 @ents = grep {$_ ne '.' && $_ ne '..'} @ents; 1400 unshift @ents, '.', '..'; 1401 my $data = "<pre>\n"; 1402 for my $ent (@ents) { 1403 @s = lstat("$root$path_info/$ent"); 1404 if (!@s) { 1405 $data .= escape("$ent: $!\n"); 1406 next; 1407 } 1408 my $ent2 = ''; 1409 my $info = '?'; 1410 $info = 'c' if -c _; 1411 $info = 'b' if -b _; 1412 $info = '-' if -f _; 1413 $info = 'd' if -d _; 1414 if (-l _) { 1415 $info = 'l'; 1416 $ent2 = readlink("$root$path_info/$ent"); 1417 die("$root$path_info/$ent: $!") unless defined $ent2; 1418 $ent2 = escape(" -> $ent2"); 1419 } 1420 my $mode = $s[2] & 0777; 1421 for (split('', 'rwxrwxrwx')) { 1422 $info .= $mode & 0400 ? $_ : '-'; 1423 $mode *= 2; 1424 } 1425 my @lt = localtime($s[9]); 1426 $lt[4] += 1; 1427 $lt[5] += 1900; 1428 $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]); 1429 $info = escape($info); 1430 my $ne = "$path_info/$ent"; 1431 $ne = $path_info if $ent eq '.'; 1432 if ($ent eq '..') { 1433 $ne = $path_info; 1434 $ne =~ s/[^\/]+$//; 1435 $ne =~ s/\/$//; 1436 } 1437 if ((-d _) && ! (-l _)) { 1438 $ent = "<a href=\"".aescape("$script_name$ne/")."\">".escape("$ent")."</a>$ent2"; 1439 } elsif ((-f _) && ! (-l _)) { 1440 $ent = "<a href=\"".aescape("$script_name$ne")."\">".escape("$ent")."</a>$ent2"; 1441 } else { 1442 $ent = escape("$ent").$ent2; 1443 } 1444 $data .= "$info $ent\n"; 1445 } 1446 $data .= "</pre>\n"; 1447 reply($data, "Content-type: text/html"); 1448 exit(0); 1449 } 1450 1451 if (!@s) { 1452 sendlog("- $path_info"); 1453 my $data = "${replyid}0001GONE".sprintf("%08x", length($spath_info)).'00000000'.$spath_info; 1454 reply($data, "Content-type: application/octet-stream"); 1455 return; 1456 } 1457 1458 if (-d _) { 1459 # oops, this is bad, the file is now a directory 1460 # send GONE so it will get removed 1461 sendlog("X $path_info"); 1462 my $data = "${replyid}0001GONE".sprintf("%08x", length($spath_info)).'00000000'.$spath_info; 1463 reply($data, "Content-type: application/octet-stream"); 1464 return; 1465 } 1466 1467 if (-l _) { 1468 sendlog("f $path_info"); 1469 my $lc = readlink("$root$path_info"); 1470 die("readlink: $!\n") unless defined($lc); 1471 $lc = sprintf("2%03x%08x", $s[2] & 07777, $s[9]).$lc; 1472 my $data = "${replyid}0001FILE".sprintf("%08x%08x", length($spath_info), length($lc)).$spath_info.$lc.Digest::MD5::md5_hex($lc); 1473 reply($data, "Content-type: application/octet-stream"); 1474 return; 1475 } 1476 1477 die("$spath_info: bad file type\n") unless -f _; 1478 open(F, '<', "$root$path_info") || die("$spath_info: $!\n"); 1479 1480 my $extracto = 0; 1481 my $extractl; 1482 1483 if ((exists($cgi->{'fiso'}) || exists($cgi->{'extract'})) && ($spath_info =~ /(?<!\.delta)\.iso$/i)) { 1484 if (!$cgi->{'extract'}) { 1485 tmpopen(*F2, $servertmp); 1486 my (undef, $err) = runprg(*F, *F2, $fragiso, 'make', '-', '-'); 1487 die("fragiso make failed: $err\n") if $err; 1488 close F; 1489 sysseek(F2, 0, 0); # currently at EOF 1490 sendlog("i $path_info"); 1491 my $flen = -s F2; 1492 my $ctx = Digest::MD5->new; 1493 my $data = sprintf("1%03x%08x", $s[2] & 07777, $s[9]); 1494 $ctx->add($data); 1495 $data = "${replyid}0001FISO".sprintf("%08x", length($spath_info)).hexit(length($data) + $flen).$spath_info.$data; 1496 replystream(*F2, $flen, $data, $ctx, "Content-type: application/octet-stream"); 1497 close F2; 1498 return; 1499 } else { 1500 die("bad extract: $cgi->{'extract'}\n") unless $cgi->{'extract'} =~ /^([0-9a-fA-F]{2})([0-9a-fA-F]{8}):([0-9a-fA-F]{8})$/; 1501 # always fits in perl's floats 1502 $extracto = hex($1) * 4294967296 + hex($2); 1503 $extractl = hex($3); 1504 defined(sysseek(F, $extracto, 0)) || die("seek error: $!\n"); 1505 $path_info .= "\@$cgi->{'extract'}"; 1506 } 1507 } elsif ($spath_info !~ /\.[sr]pm$/) { 1508 my $flen = $s[7]; 1509 my $data = sprintf("1%03x%08x", $s[2] & 07777, $s[9]); 1510 if ($s[7] >= 67108864) { 1511 sendlog("f $path_info"); 1512 my $ctx = Digest::MD5->new; 1513 $ctx->add($data); 1514 $data = "${replyid}0001FILE".sprintf("%08x", length($spath_info)).hexit(length($data) + $flen).$spath_info.$data; 1515 replystream(*F, $flen, $data, $ctx, "Content-type: application/octet-stream"); 1516 return; 1517 } 1518 while ((sysread(F, $data, 4096, length($data)) || 0) == 4096) {} 1519 close F; 1520 my $dataid = 'FILE'; 1521 if (length($data) >= 12 + 64 && $have_zlib && exists($cgi->{'zlib'}) && substr($data, 12, 2) ne "\037\213" && substr($data, 12, 2) ne "BZ") { 1522 $data = substr($data, 0, 12).Compress::Zlib::compress(substr($data, 12)); 1523 $dataid = 'FILZ'; 1524 sendlog("z $path_info"); 1525 } else { 1526 sendlog("f $path_info"); 1527 } 1528 $data = "${replyid}0001$dataid".sprintf("%08x%08x", length($spath_info), length($data)).$spath_info.$data.Digest::MD5::md5_hex($data); 1529 reply($data, "Content-type: application/octet-stream"); 1530 return; 1531 } 1532 1533 my $deltadata = ''; 1534 my $deltaintro = ''; 1535 my $deltanum = 0; 1536 my $sendrpm = exists($cgi->{'withrpm'}) ? 1 : 0; 1537 my $key = ''; 1538 if ($cgi->{'have'}) { 1539 my %have2; 1540 for (split(',', $cgi->{'havealso'} ? "$cgi->{'have'},$cgi->{'havealso'}" : $cgi->{'have'})) { 1541 die("bad have parameter\n") if (length($_) != 32 && length($_) != 64) || /[^0-9a-f]/; 1542 $have2{substr($_, -32, 32)} = 1; 1543 } 1544 my @info = rpminfo_f(*F, $spath_info); 1545 die("$spath_info: bad info\n") unless @info; 1546 # seek needed because of perl's autoflush when forking 1547 seek(F, $extracto, 0); 1548 # only sysread after this! 1549 defined(sysseek(F, $extracto, 0)) || die("sysseek: $!\n"); 1550 $path_info .= " ($info[2])" if $extracto; 1551 my $info = $info[0]; 1552 my $info1 = substr($info, 0, 32); 1553 my $info2 = substr($info, 32, 32); 1554 if ($have2{$info2}) { 1555 if ($extracto) { 1556 # switch to real rpm 1557 extractrpm(*F, $extracto, $extractl); 1558 $extracto = 0; 1559 $extractl = undef; 1560 } 1561 # identical payload, create sign only delta 1562 # sendlog("$path_info: makedeltarpm sign only"); 1563 my ($out, $err) = runprg(*F, undef, $makedeltarpm, '-u', '-r', '-', '-'); 1564 die("makedeltarpm failed: $err\n") if $err; 1565 $deltaintro .= sprintf("1%03x%08x$info2$info1$info2%08x", $s[2] & 07777, $s[9], length($out)); 1566 $deltadata .= $out; 1567 $deltanum++; 1568 $key = 's'; 1569 $sendrpm = 0; # no need to send full rpm in this case 1570 } elsif (!exists($cgi->{'nocomplexdelta'})) { 1571 # ok, lets see if we can build a chain from info2 back to have2 1572 my $dpn = $info[2]; 1573 lost_delta: 1574 $key = ''; 1575 $deltadata = ''; 1576 $deltaintro = ''; 1577 $deltanum = 0; 1578 1579 my $deltadir = "$root$path_info"; 1580 if ($path_info ne '') { 1581 $deltadir =~ s/[^\/]+$//; 1582 $deltadir =~ s/\/$//; 1583 while ($deltadir ne $root) { 1584 last if -d "$deltadir/drpmsync/deltas"; 1585 $deltadir =~ s/[^\/]+$//; 1586 $deltadir =~ s/\/$//; 1587 } 1588 } 1589 $deltadir = "$deltadir/drpmsync/deltas/$dpn"; 1590 my @solution; 1591 if (length($cgi->{'have'}) == 64 && -f "$deltadir/$cgi->{'have'}$info2") { 1592 @solution = ("$deltadir/$cgi->{'have'}$info2"); 1593 } else { 1594 my @deltadirs = ( $deltadir ); 1595 push @deltadirs, map {"$_/$dpn"} getdeltadirs($tree->{'deltadirs'}, $spath_info) if $tree->{'deltadirs'}; 1596 @solution = solve(\%have2, $info2, @deltadirs); 1597 } 1598 my $dsize = 0; 1599 for (@solution) { 1600 goto lost_delta if ! -e $_; 1601 die("bad deltarpm: $_\n") if ! -f _; 1602 if (!exists($cgi->{'uncombined'}) && !$tree->{'no_combine'}) { 1603 $dsize = -s _ if (-s _) > $dsize; 1604 } else { 1605 $dsize += -s _; 1606 } 1607 } 1608 my $maxdeltasize = $cgi->{'maxdeltasize'}; 1609 $maxdeltasize = $tree->{'maxdeltasize'} if defined($tree->{'maxdeltasize'}) && (!defined($maxdeltasize) || $maxdeltasize > $tree->{'maxdeltasize'}); 1610 if (defined($maxdeltasize)) { 1611 my $flen = -s F; 1612 $flen = $extractl if defined $extractl; 1613 @solution = () if $dsize >= ($flen * $maxdeltasize) / 100; 1614 } 1615 my $maxdeltasizeabs = $cgi->{'maxdeltasizeabs'}; 1616 $maxdeltasizeabs = $tree->{'maxdeltasizeabs'} if defined($tree->{'maxdeltasizeabs'}) && (!defined($maxdeltasizeabs) || $maxdeltasizeabs > $tree->{'maxdeltasizeabs'}); 1617 @solution = () if defined($maxdeltasizeabs) && $dsize >= $maxdeltasizeabs; 1618 if (@solution) { 1619 # sendlog("$path_info: solution @solution"); 1620 my @combine = (); 1621 $key = scalar(@solution) if @solution > 1; 1622 $key .= 'd'; 1623 for my $dn (@solution) { 1624 push @combine, $dn; 1625 next if @combine < @solution && !exists($cgi->{'uncombined'}) && !$tree->{'no_combine'}; 1626 my @ds = stat($combine[0]); 1627 goto lost_delta if !@ds || ! -f _; 1628 my ($out, $err); 1629 if ($dn eq $solution[-1] && substr($dn, -64, 32) ne $info1) { 1630 # sendlog("$path_info: combinedeltarpm -S @combine"); 1631 if ($extracto) { 1632 # switch to real rpm 1633 extractrpm(*F, $extracto, $extractl); 1634 $extracto = 0; 1635 $extractl = undef; 1636 } 1637 ($out, $err) = runprg(*F, undef, $combinedeltarpm, '-S', '-', @combine, '-'); 1638 defined(sysseek(F, 0, 0)) || die("sysseek: $!\n"); 1639 substr($combine[-1], -64, 32) = $info1 unless $err; 1640 $key .= 's'; 1641 } elsif (@combine > 1) { 1642 # sendlog("$path_info: combinedeltarpm @combine"); 1643 ($out, $err) = runprg(undef, undef, $combinedeltarpm, @combine, '-'); 1644 } else { 1645 # sendlog("$path_info: readfile @combine"); 1646 ($out, $err) = readfile($dn); 1647 } 1648 if ($err) { 1649 goto lost_delta if grep {! -f $_} @combine; 1650 $err =~ s/\n$//s; 1651 sendlog("! $path_info $err"); 1652 %have2 = (); # try without deltas 1653 goto lost_delta; 1654 } 1655 $deltaintro .= sprintf("1%03x%08x".substr($combine[0], -96, 32).substr($combine[-1], -64, 64)."%08x", $ds[2] & 07777, $ds[9], length($out)); 1656 $deltadata .= $out; 1657 $deltanum++; 1658 @combine = (); 1659 } 1660 $key .= $deltanum if $deltanum != 1; 1661 } 1662 } 1663 } 1664 if (exists($cgi->{'deltaonly'}) && !$deltanum) { 1665 sendlog("O $path_info"); 1666 my $data = "${replyid}0001NODR".sprintf("%08x", length($spath_info)).'00000000'.$spath_info; 1667 reply($data, "Content-type: application/octet-stream"); 1668 return; 1669 } 1670 $sendrpm = 1 if !$deltanum; 1671 $key .= 'r' if $sendrpm; 1672 $key = '?' if $key eq ''; 1673 sendlog("$key $path_info"); 1674 if ($sendrpm) { 1675 my $flen = -s F; 1676 $flen = $extractl if defined $extractl; 1677 if ($flen > 100000 || defined($extractl)) { 1678 my $data = sprintf("1%03x%08x", $s[2] & 07777, $s[9]); 1679 $data .= sprintf("%08x%08x", $deltanum, $sendrpm).$deltaintro.$deltadata; 1680 my $ctx = Digest::MD5->new; 1681 $ctx->add($data); 1682 $data = "${replyid}0001RPM ".sprintf("%08x%08x", length($spath_info), length($data) + $flen).$spath_info.$data; 1683 replystream(*F, $flen, $data, $ctx, "Content-type: application/octet-stream"); 1684 close F; 1685 return; 1686 } 1687 } 1688 my $rdata = ''; 1689 if ($sendrpm) { 1690 while ((sysread(F, $rdata, 4096, length($rdata)) || 0) == 4096) {} 1691 } 1692 my $data = sprintf("1%03x%08x", $s[2] & 07777, $s[9]); 1693 $data .= sprintf("%08x%08x", $deltanum, $sendrpm).$deltaintro.$deltadata.$rdata; 1694 undef $deltadata; 1695 $data = "${replyid}0001RPM ".sprintf("%08x%08x", length($spath_info), length($data)).$spath_info.$data.Digest::MD5::md5_hex($data); 1696 reply($data, "Content-type: application/octet-stream"); 1697 close F; 1698 undef $data; 1699} 1700 1701if ($::ENV{'REQUEST_METHOD'} || (@ARGV && ($ARGV[0] eq '-s' || $ARGV[0] eq '-S'))) { 1702 # server mode 1703 my %cgi; 1704 my $request_method = $::ENV{'REQUEST_METHOD'}; 1705 if ($request_method) { 1706 my $query_string = $::ENV{'QUERY_STRING'}; 1707 my $script_name = $::ENV{'SCRIPT_NAME'}; 1708 my $path_info = $::ENV{'PATH_INFO'}; 1709 my $remote_addr = $::ENV{'REMOTE_ADDR'}; 1710 if ($request_method eq 'POST') { 1711 $query_string = ''; 1712 read(STDIN, $query_string, 0 + $::ENV{'CONTENT_LENGTH'}); 1713 } 1714 eval { 1715 parse_cgi(\%cgi, $query_string); 1716 my $config = $::ENV{'DRPMSYNC_CONFIG'}; 1717 readconfig_server($config); 1718 serve_request(\%cgi, $path_info, $script_name, $remote_addr, 0); 1719 exit(0); 1720 }; 1721 reply_err($@, \%cgi, $remote_addr); 1722 exit(0); 1723 } 1724 my $remote_addr = startserver($ARGV[1], $ARGV[0] eq '-S' ? 1 : 0); 1725 eval { 1726 while (1) { 1727 %cgi = (); 1728 my ($path, $query_string, $has_via) = getrequest(\%cgi); 1729 $request_method = 'GET'; 1730 parse_cgi(\%cgi, $query_string); 1731 my $keep_ok = !$has_via && exists($cgi{'drpmsync'}); 1732 my @mtrees = grep {$path eq $_->{'id'} || substr($path, 0, length($_->{'id'}) + 1) eq "$_->{'id'}/" } sort {length($b->{'id'}) <=> length($a->{'id'})} values %trees; 1733 die("not exported\n") unless @mtrees; 1734 my $script_name = $mtrees[0]->{'id'}; 1735 my $path_info = substr($path, length($script_name)); 1736 serve_request(\%cgi, $path_info, $script_name, $remote_addr, $keep_ok); 1737 exit(0) unless $keep_ok; 1738 } 1739 }; 1740 reply_err($@, \%cgi, $remote_addr); 1741 exit(0); 1742} 1743 1744 1745####################################################################### 1746# Client code 1747####################################################################### 1748 1749my @config_source; 1750my $config_generate_deltas; 1751my $config_keep_deltas; 1752my $config_keep_uncombined; 1753my $config_always_get_rpm; 1754my @config_generate_delta_compression; 1755my $config_recvlog; 1756my $config_delta_max_age; 1757my $config_repo; 1758my $config_timeout; 1759my @config_filter; 1760my @config_filter_arch; 1761 1762my $syncport; 1763my $syncaddr; 1764my $syncproto; 1765my $syncuser; 1766my $syncpassword; 1767my $syncurl; 1768my $syncroot; 1769my $esyncroot; 1770my $synctree = ''; 1771my $synchost = Net::Domain::hostfqdn(); 1772 1773my $newstamp1; 1774my $newstamp2; 1775 1776my $runningjob; 1777 1778sub readconfig_client { 1779 my $cf = shift; 1780 local *CF; 1781 open(CF, '<', $cf) || die("$cf: $!\n"); 1782 while (<CF>) { 1783 chomp; 1784 s/^\s+//; 1785 s/\s+$//; 1786 next if $_ eq '' || /^#/; 1787 my @s = split(' ', $_); 1788 $s[0] = lc($s[0]); 1789 if ($s[0] eq 'source:') { 1790 shift @s; 1791 @config_source = @s; 1792 } elsif ($s[0] eq 'generate_deltas:') { 1793 $config_generate_deltas = ($s[1] && $s[1] =~ /true/i); 1794 } elsif ($s[0] eq 'generate_delta_compression:') { 1795 @config_generate_delta_compression = (); 1796 @config_generate_delta_compression = ('-z', $s[1]) if $s[1]; 1797 } elsif ($s[0] eq 'keep_deltas:') { 1798 $config_keep_deltas = ($s[1] && $s[1] =~ /true/i); 1799 } elsif ($s[0] eq 'keep_uncombined:') { 1800 $config_keep_uncombined = ($s[1] && $s[1] =~ /true/i); 1801 } elsif ($s[0] eq 'always_get_rpm:') { 1802 $config_always_get_rpm = ($s[1] && $s[1] =~ /true/i); 1803 } elsif ($s[0] eq 'delta_max_age:') { 1804 $config_delta_max_age = @s > 1 ? $s[1] : undef; 1805 } elsif ($s[0] eq 'timeout:') { 1806 $config_timeout = @s > 1 ? $s[1] : undef; 1807 } elsif ($s[0] eq 'deltarpmpath:') { 1808 my $p = defined($s[1]) ? "$s[1]/" : ''; 1809 $makedeltarpm = "${p}makedeltarpm"; 1810 $combinedeltarpm = "${p}combinedeltarpm"; 1811 $applydeltarpm = "${p}applydeltarpm"; 1812 $fragiso = "${p}fragiso"; 1813 } elsif ($s[0] eq 'log:') { 1814 $config_recvlog = @s > 1 ? $s[1] : undef; 1815 } elsif ($s[0] eq 'repo:') { 1816 $config_repo = @s > 1 ? $s[1] : undef; 1817 } elsif ($s[0] eq 'exclude:') { 1818 push @config_filter, map {"-$_"} @s; 1819 } elsif ($s[0] eq 'include:') { 1820 push @config_filter, map {"+$_"} @s; 1821 } elsif ($s[0] eq 'exclude_arch:') { 1822 push @config_filter_arch, map {"-$_"} @s; 1823 } elsif ($s[0] eq 'include_arch:') { 1824 push @config_filter_arch, map {"+$_"} @s; 1825 } else { 1826 $s[0] =~ s/:$//; 1827 die("$cf: unknown configuration parameter: $s[0]\n"); 1828 } 1829 } 1830 $config_keep_deltas ||= $config_generate_deltas; 1831 $config_keep_deltas ||= $config_keep_uncombined; 1832 close CF; 1833} 1834 1835####################################################################### 1836 1837sub mkdir_p { 1838 my $dir = shift; 1839 return if -d $dir; 1840 mkdir_p($1) if $dir =~ /^(.*)\//; 1841 mkdir($dir, 0777) || die("mkdir: $dir: $!\n"); 1842} 1843 1844####################################################################### 1845 1846sub toiso { 1847 my @lt = localtime($_[0]); 1848 $lt[5] += 1900; 1849 $lt[4] += 1; 1850 return sprintf "%04d-%02d-%02d %02d:%02d:%02d", @lt[5,4,3,2,1,0]; 1851} 1852 1853####################################################################### 1854 1855sub recvlog { 1856 my $str = shift; 1857 1858 return unless $config_recvlog; 1859 my @lt = localtime(time()); 1860 $lt[5] += 1900; 1861 $lt[4] += 1; 1862 printf RECVLOG "%04d-%02d-%02d %02d:%02d:%02d %s\n", @lt[5,4,3,2,1,0], $str; 1863} 1864 1865sub recvlog_print { 1866 my $str = shift; 1867 print "$str\n"; 1868 recvlog($str); 1869} 1870 1871####################################################################### 1872 1873sub makedelta { 1874 my ($from, $to, $drpm) = @_; 1875 # print "makedeltarpm $from $to\n"; 1876 if (substr($drpm, -96, 32) eq substr($drpm, -32, 32)) { 1877 system($makedeltarpm, @config_generate_delta_compression, '-u', '-r', $to, $drpm) && die("makedeltarpm failed\n"); 1878 } else { 1879 system($makedeltarpm, @config_generate_delta_compression, '-r', $from, $to, $drpm) && die("makedeltarpm failed\n"); 1880 } 1881 die("makedeltarpm did not create delta\n") unless -s $drpm; 1882 return $drpm; 1883} 1884 1885sub applydeltas { 1886 my ($job, $from, $to, $extractoff, @deltas) = @_; 1887 my $dn = $deltas[0]; 1888 if (@deltas > 1) { 1889 my $ddir = $deltas[0]; 1890 $ddir =~ s/\/[^\/]+$//; 1891 my $d1 = $deltas[0]; 1892 my $d2 = $deltas[-1]; 1893 my @d1s = stat($d1); 1894 die("$d1: $!\n") if !@d1s; 1895 $d1 =~ s/.*\///; 1896 $d2 =~ s/.*\///; 1897 $dn = "$ddir/".substr($d1, 0, 32).substr($d2, 32, 64); 1898 die("combined delta already exists?\n") if -f $dn; 1899 # print "combinedeltarpm @deltas\n"; 1900 if (system($combinedeltarpm, @deltas, $dn) || ! -s $dn) { 1901 recvlog_print("! combinedeltarpm @deltas $dn failed"); 1902 unlink @deltas; 1903 return (); 1904 } 1905 utime($d1s[9], $d1s[9], $dn); 1906 } 1907 # print "applydeltarpm $from $dn\n"; 1908 my $err; 1909 if ($extractoff) { 1910 local *EXTR; 1911 if (!open(EXTR, '+<', $to)) { 1912 recvlog_print("! open $to failed: $!"); 1913 unlink(@deltas); 1914 return (); 1915 } 1916 if (!defined(sysseek(EXTR, $extractoff, 0))) { 1917 recvlog_print("! sysseek $to failed: $!"); 1918 unlink(@deltas); 1919 return (); 1920 } 1921 (undef, $err) = runprg_job($job, undef, *EXTR, $applydeltarpm, '-r', $from, $dn, '-'); 1922 close(EXTR); 1923 } else { 1924 (undef, $err) = runprg_job($job, undef, undef, $applydeltarpm, '-r', $from, $dn, $to); 1925 } 1926 if ($err) { 1927 recvlog_print("! applydeltarpm -r $from $dn $to failed: $err"); 1928 unlink(@deltas); 1929 return (); 1930 } 1931 if ($job) { 1932 $job->{'applydeltas'} = [$from, $dn, $to, @deltas]; 1933 return ($job); 1934 } 1935 if ($config_keep_uncombined || @deltas <= 1) { 1936 if (@deltas > 1) { 1937 unlink($dn) || die("unlink $dn: $!\n"); 1938 } 1939 return @deltas; 1940 } 1941 for my $d (@deltas) { 1942 unlink($d) || die("unlink $d: $!\n"); 1943 } 1944 return ($dn); 1945} 1946 1947sub applydeltas_finish { 1948 my ($job) = @_; 1949 die("job not running\n") unless $job && $job->{'applydeltas'}; 1950 my ($from, $dn, $to, @deltas) = @{$job->{'applydeltas'}}; 1951 delete $job->{'applydeltas'}; 1952 my $err; 1953 (undef, $err) = runprg_finish($job); 1954 if ($err) { 1955 recvlog_print("! applydeltarpm -r $from $dn $to failed: $err"); 1956 unlink(@deltas); 1957 return (); 1958 } 1959 if ($config_keep_uncombined || @deltas <= 1) { 1960 if (@deltas > 1) { 1961 unlink($dn) || die("unlink $dn: $!\n"); 1962 } 1963 return @deltas; 1964 } 1965 for my $d (@deltas) { 1966 unlink($d) || die("unlink $d: $!\n"); 1967 } 1968 return ($dn); 1969} 1970 1971sub checkjob { 1972 my ($pn) = @_; 1973 return unless $runningjob; 1974 my $job = $runningjob; 1975 if (defined($pn)) { 1976 return if $job->{'wip'} ne $pn; 1977 } 1978 undef $runningjob; 1979 my @args = @{$job->{'finishargs'}}; 1980 delete $job->{'finishargs'}; 1981 $job->{'finish'}->(@args); 1982} 1983 1984 1985####################################################################### 1986# repo functions 1987####################################################################### 1988 1989sub repo_search { 1990 my ($dpn, $k) = @_; 1991 local *F; 1992 open(F, '<', "$config_repo/$dpn") || return (); 1993 my $k2 = substr($k, 32, 32); 1994 my ($l, @l); 1995 my (@r1, @r2, @r3); 1996 while (defined($l = <F>)) { 1997 chomp $l; 1998 my @l = split(' ', $l, 3); 1999 if ($l[0] eq $k) { 2000 push @r1, \@l; 2001 } elsif (substr($l[0], 32, 32) eq $k2) { 2002 push @r2, \@l; 2003 } else { 2004 push @r3, \@l; 2005 } 2006 } 2007 close F; 2008 return (@r1, @r2, @r3); 2009} 2010 2011sub repo_check { 2012 my (@r) = @_; 2013 2014 my @s; 2015 for my $r (splice(@r)) { 2016 if ($r->[2] =~ /^(.*)@([0-9a-f]{10}:[0-9a-f]{8}$)/) { 2017 @s = stat($1); 2018 } else { 2019 @s = stat($r->[2]); 2020 } 2021 push @r, $r if @s && $r->[1] eq "$s[9]/$s[7]"; 2022 } 2023 return @r; 2024} 2025 2026sub repo_cp { 2027 my ($r, $bdir, $to, $extractoff) = @_; 2028 2029 my $d = "$bdir/$to"; 2030 2031 local(*F, *OF); 2032 my @s; 2033 my $len; 2034 if ($r->[2] =~ /^(.*)@([0-9a-f]{2})([0-9a-f]{8}):([0-9a-f]{8}$)/) { 2035 my $iso = $1; 2036 open(F, '<', $iso) || return undef; 2037 @s = stat(F); 2038 if (!@s || $r->[1] ne "$s[9]/$s[7]") { 2039 close F; 2040 return undef; 2041 } 2042 $len = hex($4); 2043 if (!$len || !defined(sysseek(F, hex($2) * 4294967296 + hex($3), 0))) { 2044 close F; 2045 return undef; 2046 } 2047 } else { 2048 open(F, '<', $r->[2]) || return undef; 2049 @s = stat(F); 2050 if (!@s || $r->[1] ne "$s[9]/$s[7]") { 2051 close F; 2052 return undef; 2053 } 2054 } 2055 if ($extractoff) { 2056 if (!open(OF, '+<', $d)) { 2057 close F; 2058 return undef; 2059 } 2060 if (!defined(sysseek(OF, $extractoff, 0))) { 2061 close F; 2062 close OF; 2063 return undef; 2064 } 2065 } else { 2066 if (!open(OF, '>', $d)) { 2067 close F; 2068 return undef; 2069 } 2070 } 2071 my @info = cprpm(*F, *OF, 1, $len); 2072 if (!close(OF)) { 2073 close(F); 2074 unlink($d); 2075 return undef; 2076 } 2077 close(F); 2078 if (@info != 3 || $info[0] ne $r->[0]) { 2079 unlink($d); 2080 return undef; 2081 } 2082 @s = stat($d); 2083 if (!@s) { 2084 unlink($d); 2085 return undef; 2086 } 2087 return [ $to, "$s[9]/$s[7]/$s[1]", sprintf("1%03x%08x", ($s[2] & 07777), $s[9]), @info ]; 2088} 2089 2090sub repo_add_iso { 2091 my ($fn, $d) = @_; 2092 local *F; 2093 return unless open(F, '-|', $fragiso, 'listiso', $fn); 2094 my @frags = <F>; 2095 return unless close(F); 2096 chomp @frags; 2097 for my $f (@frags) { 2098 my @f = split(' ', $f, 3); 2099 repo_add("$fn\@$f[0]", [ "$fn\@$f[0]", $d->[1], $d->[2], $f[1], undef, $f[2] ] ); 2100 } 2101} 2102 2103sub repo_add { 2104 my ($fn, $d) = @_; 2105 2106 return if $fn =~ m!drpmsync/wip.*/!; 2107 if (@$d < 6) { 2108 repo_add_iso($fn, $d) if $fn =~ /(?<!\.delta)\.iso$/i; 2109 return; 2110 } 2111 return if $fn =~ /[\000-\037]/; 2112 return if $d->[5] =~ /[\000-\037\/]/ || length($d->[5]) < 3; 2113 local *OLD; 2114 local *NEW; 2115 my $nlid = $d->[1]; 2116 $nlid =~ s/\/[^\/]*$//; 2117 my $nl; 2118 $nl = "$d->[3] $nlid $fn" if $nlid; 2119 my $kill; 2120 $kill = $1 if $fn =~ /^(.*)@[0-9a-f]{2}[0-9a-f]{8}:[0-9a-f]{8}$/; 2121 $kill = $fn if !$nlid && $fn =~ /(?<!\.delta)\.iso$/i; 2122lock_retry: 2123 if (!sysopen(OLD, "$config_repo/$d->[5]", POSIX::O_RDWR|POSIX::O_CREAT, 0666)) { 2124 if (!sysopen(OLD, "$config_repo/$d->[5]", POSIX::O_RDONLY)) { 2125 warn("$config_repo/$d->[5]: $!\n"); 2126 return; 2127 } 2128 } 2129 if (!flock(OLD, LOCK_EX)) { 2130 warn("$config_repo/$d->[5]: flock: $!\n"); 2131 return; 2132 } 2133 if (!(stat(OLD))[3]) { 2134 close(OLD); 2135 goto lock_retry; 2136 } 2137 my $old = ''; 2138 my $new = ''; 2139 while ((sysread(OLD, $old, 8192, length($old)) || 0) == 8192) {}; 2140 for my $l (split("\n", $old)) { 2141 if ($nl && $l eq $nl) { 2142 undef $nl; 2143 } else { 2144 if ($kill) { 2145 my @lf = split(' ', $l); 2146 next if $lf[2] =~ /^(.*)@[0-9a-f]{2}[0-9a-f]{8}:[0-9a-f]{8}$/ && $kill eq $1 && $lf[1] ne $nlid; 2147 } else { 2148 next if (split(' ', $l))[2] eq $fn; 2149 } 2150 } 2151 $new .= "$l\n"; 2152 } 2153 if ($nl) { 2154 $new .= "$nl\n"; 2155 } elsif ($old eq $new) { 2156 close OLD; 2157 return; 2158 } 2159 if (!sysopen(NEW, "$config_repo/$d->[5].new", POSIX::O_WRONLY|POSIX::O_CREAT|POSIX::O_TRUNC, 0666)) { 2160 warn("$config_repo/$d->[5].new open: $!\n"); 2161 close(OLD); 2162 return; 2163 } 2164 if ((syswrite(NEW, $new) || 0) != length($new) || !close(NEW)) { 2165 warn("$config_repo/$d->[5].new write: $!\n"); 2166 close(NEW); 2167 close(OLD); 2168 unlink("$config_repo/$d->[5].new"); 2169 return; 2170 } 2171 if (!rename("$config_repo/$d->[5].new", "$config_repo/$d->[5]")) { 2172 warn("$config_repo/$d->[5] rename: $!\n"); 2173 close(OLD); 2174 unlink("$config_repo/$d->[5].new"); 2175 return; 2176 } 2177 close(OLD); 2178} 2179 2180sub repo_del { 2181 my ($fn, $d) = @_; 2182 my $dir; 2183 if (@$d > 5) { 2184 $dir = $d->[5]; 2185 } else { 2186 return if $fn !~ /(?<!\.delta)\.iso$/i; 2187 } 2188 if (!$dir) { 2189 local *DIR; 2190 opendir(DIR, $config_repo) || return; 2191 my @ds = grep {$_ ne '.' && $_ ne '..' && !/\..*\.new$/} readdir(DIR); 2192 closedir(DIR); 2193 for my $ds (@ds) { 2194 repo_add($fn, [undef, '', undef, undef, undef, $ds]); 2195 } 2196 } else { 2197 repo_add($fn, [undef, '', undef, undef, undef, $dir]); 2198 } 2199} 2200 2201sub repo_validate { 2202 my $d = shift; 2203 if (!$d) { 2204 local *DIR; 2205 opendir(DIR, $config_repo) || return; 2206 my @ds = grep {$_ ne '.' && $_ ne '..' && !/\..*\.new$/} readdir(DIR); 2207 closedir(DIR); 2208 for my $ds (@ds) { 2209 repo_validate($ds); 2210 } 2211 return; 2212 } 2213 local *OLD; 2214 local *NEW; 2215lock_retry: 2216 if (!sysopen(OLD, "$config_repo/$d", POSIX::O_RDWR|POSIX::O_CREAT, 0666)) { 2217 if (!sysopen(OLD, "$config_repo/$d", POSIX::O_RDONLY)) { 2218 warn("$config_repo/$d: $!\n"); 2219 return; 2220 } 2221 } 2222 if (!flock(OLD, LOCK_EX)) { 2223 warn("$config_repo/$d: flock: $!\n"); 2224 return; 2225 } 2226 if (!(stat(OLD))[3]) { 2227 close(OLD); 2228 goto lock_retry; 2229 } 2230 my $old = ''; 2231 my $new = ''; 2232 while ((sysread(OLD, $old, 8192, length($old)) || 0) == 8192) {}; 2233 for my $l (split("\n", $old)) { 2234 my @lf = split(' ', $l); 2235 my @s; 2236 if ($lf[2] =~ /^(.*)@[0-9a-f]{2}[0-9a-f]{8}:[0-9a-f]{8}$/) { 2237 @s = stat($1); 2238 } else { 2239 @s = stat($lf[2]); 2240 } 2241 next if !@s || "$s[9]/$s[7]" ne $lf[1]; 2242 $new .= "$l\n"; 2243 } 2244 if ($new eq $old) { 2245 close OLD; 2246 return; 2247 } 2248 if (!sysopen(NEW, "$config_repo/$d.new", POSIX::O_WRONLY|POSIX::O_CREAT|POSIX::O_TRUNC, 0666)) { 2249 warn("$config_repo/$d.new open: $!\n"); 2250 close(OLD); 2251 return; 2252 } 2253 if ((syswrite(NEW, $new) || 0) != length($new) || !close(NEW)) { 2254 warn("$config_repo/$d.new write: $!\n"); 2255 close(NEW); 2256 close(OLD); 2257 unlink("$config_repo/$d.new"); 2258 return; 2259 } 2260 if (!rename("$config_repo/$d.new", "$config_repo/$d")) { 2261 warn("$config_repo/$d rename: $!\n"); 2262 close(OLD); 2263 unlink("$config_repo/$d.new"); 2264 return; 2265 } 2266 close(OLD); 2267} 2268 2269####################################################################### 2270 2271my %files; 2272my %syncfiles; 2273my $had_gone; 2274 2275sub dirchanged { 2276 my $dir = shift; 2277 $dir =~ s/[^\/]+$//; 2278 $dir =~ s/\/+$//; 2279 return unless $dir ne ''; 2280 my $d = $files{$dir}; 2281 return unless $d && $d->[2] =~ /^0/; 2282 $d->[2] = substr($d->[2], 0, 4)."ffffffff"; 2283} 2284 2285 2286################################################################## 2287 2288my $net_start_tv; 2289my $net_start_rvbytes; 2290my $net_recv_bytes = 0; 2291my $net_spent_time = 0; 2292 2293my $txbytes = 0; 2294my $rvbytes = 0; 2295my $sabytes = 0; 2296 2297sub setup_proto { 2298 my $proto = shift; 2299 if ($proto eq 'file') { 2300 *get_syncfiles = \&file_get_syncfiles; 2301 *get_update = \&file_get_update; 2302 *send_fin = \&file_send_fin; 2303 } elsif ($proto eq 'drpmsync') { 2304 *get_syncfiles = \&drpmsync_get_syncfiles; 2305 *get_update = \&drpmsync_get_update; 2306 *send_fin = \&drpmsync_send_fin; 2307 } elsif ($proto eq 'rsync') { 2308 *get_syncfiles = \&rsync_get_syncfiles; 2309 *get_update = \&rsync_get_update; 2310 *send_fin = \&rsync_send_fin; 2311 } elsif ($proto eq 'null') { 2312 *get_syncfiles = sub {return ()}; 2313 *get_update = sub {die;}; 2314 *send_fin = sub {}; 2315 } else { 2316 die("unsupported protocol: $proto\n"); 2317 } 2318} 2319 2320####################################################################### 2321# file protocol 2322####################################################################### 2323 2324sub file_get_syncfiles { 2325 my $norecurse = shift; 2326 2327 my @oldfiles = @files; 2328 my @oldcache = %cache; 2329 my $oldcachehits = $cachehits; 2330 my $oldcachemisses = $cachemisses; 2331 @files = (); 2332 $cachehits = $cachemisses = 0; 2333 readcache("$syncroot/drpmsync/cache"); 2334 findfiles($syncroot, '', 0, $norecurse); 2335 my @syncfiles = @files; 2336 @files = @oldfiles; 2337 %cache = @oldcache; 2338 $cachehits = $oldcachehits; 2339 $cachemisses = $oldcachemisses; 2340 $newstamp1 = $newstamp2 = sprintf("%08x", time); 2341 return @syncfiles; 2342} 2343 2344sub file_get_update { 2345 my ($dto, $tmpnam, $reqext, $rextract) = @_; 2346 2347 die("rextract in FILE transport\n") if $rextract; 2348 my @s = lstat("$syncroot/$dto->[0]"); 2349 return 'GONE' unless @s; 2350 my $type; 2351 my @info; 2352 if (-l _) { 2353 $type = '2'; 2354 my $lc = readlink("$syncroot/$dto->[0]"); 2355 return 'GONE' unless defined $lc; 2356 symlink($lc, $tmpnam) || die("symlink: $!\n"); 2357 @info = linkinfo($tmpnam); 2358 } elsif (! -f _) { 2359 return 'GONE'; 2360 } else { 2361 $type = '1'; 2362 local *F; 2363 local *NF; 2364 open(F, '<', "$syncroot/$dto->[0]") || return 'GONE'; 2365 @s = stat(F); 2366 die("stat: $!\n") unless @s; 2367 open(NF, '>', $tmpnam) || die("$tmpnam: $!\n"); 2368 if ($dto->[0] !~ /\.[sr]pm$/) { 2369 @info = cpfile(*F, *NF); 2370 } else { 2371 @info = cprpm(*F, *NF); 2372 if (@info != 3) { 2373 defined(sysseek(F, 0, 0)) || die("sysseek: $!\n"); 2374 close(NF); 2375 open(NF, '>', $tmpnam) || die("$tmpnam: $!\n"); 2376 @info = cpfile(*F, *NF); 2377 } 2378 } 2379 close(F); 2380 close(NF) || die("$tmpnam: $!\n"); 2381 fixmodetime($tmpnam, sprintf("1%03x%08x", ($s[2] & 07777), $s[9])); 2382 } 2383 @s = lstat($tmpnam); 2384 die("$tmpnam: $!\n") unless @s; 2385 if (@info == 3) { 2386 return 'RPM ', [ $dto->[0], "$s[9]/$s[7]/$s[1]", sprintf("1%03x%08x", ($s[2] & 07777), $s[9]), @info ]; 2387 } else { 2388 return 'FILE', [ $dto->[0], "$s[9]/$s[7]/$s[1]", sprintf("$type%03x%08x", ($s[2] & 07777), $s[9]), @info ]; 2389 } 2390} 2391 2392sub file_send_fin { 2393} 2394 2395 2396####################################################################### 2397# rsync protocol 2398####################################################################### 2399 2400sub sread { 2401 local *SS = shift; 2402 my $len = shift; 2403 $rvbytes += $len; 2404 my $ret = ''; 2405 while ($len > 0) { 2406 my $r = sysread(SS, $ret, $len, length($ret)); 2407 die("read error") unless $r; 2408 $len -= $r; 2409 die("read too much") if $r < 0; 2410 } 2411 return $ret; 2412} 2413 2414sub swrite { 2415 local *SS = shift; 2416 my ($var, $len) = @_; 2417 $len = length($var) unless defined $len; 2418 $txbytes += $len; 2419 (syswrite(SS, $var, $len) || 0) == $len || die("syswrite: $!\n"); 2420} 2421 2422my $rsync_muxbuf = ''; 2423 2424sub muxread { 2425 local *SS = shift; 2426 my $len = shift; 2427 2428 #print "muxread $len\n"; 2429 while(length($rsync_muxbuf) < $len) { 2430 #print "muxbuf len now ".length($muxbuf)."\n"; 2431 my $tag = ''; 2432 $tag = sread(*SS, 4); 2433 $tag = unpack('V', $tag); 2434 my $tlen = 0+$tag & 0xffffff; 2435 $tag >>= 24; 2436 if ($tag == 7) { 2437 $rsync_muxbuf .= sread(*SS, $tlen); 2438 next; 2439 } 2440 if ($tag == 8 || $tag == 9) { 2441 my $msg = sread(*SS, $tlen); 2442 die("$msg\n") if $tag == 8; 2443 print "info: $msg\n"; 2444 next; 2445 } 2446 die("unknown tag: $tag\n"); 2447 } 2448 my $ret = substr($rsync_muxbuf, 0, $len); 2449 $rsync_muxbuf = substr($rsync_muxbuf, $len); 2450 return $ret; 2451} 2452 2453my $have_md4; 2454my $rsync_checksum_seed; 2455my $rsync_protocol; 2456 2457sub rsync_get_syncfiles { 2458 my $norecurse = shift; 2459 2460 my $user = $syncuser; 2461 my $password = $syncpassword; 2462 if (!defined($have_md4)) { 2463 $have_md4 = 0; 2464 eval { 2465 require Digest::MD4; 2466 $have_md4 = 1; 2467 }; 2468 } 2469 $syncroot =~ s/^\/+//; 2470 my $module = $syncroot; 2471 $module =~ s/\/.*//; 2472 my $tcpproto = getprotobyname('tcp'); 2473 socket(S, PF_INET, SOCK_STREAM, $tcpproto) || die("socket: $!\n"); 2474 connect(S, sockaddr_in($syncport, $syncaddr)) || die("connect: $!\n"); 2475 my $hello = "\@RSYNCD: 28\n"; 2476 swrite(*S, $hello); 2477 my $buf = ''; 2478 sysread(S, $buf, 4096); 2479 die("protocol error [$buf]\n") if $buf !~ /^\@RSYNCD: (\d+)\n/s; 2480 $rsync_protocol = $1; 2481 $rsync_protocol = 28 if $rsync_protocol > 28; 2482 swrite(*S, "$module\n"); 2483 while(1) { 2484 sysread(S, $buf, 4096); 2485 die("protocol error [$buf]\n") if $buf !~ s/\n//s; 2486 last if $buf eq "\@RSYNCD: OK"; 2487 die("$buf\n") if $buf =~ /^\@ERROR/s; 2488 if ($buf =~ /^\@RSYNCD: AUTHREQD /) { 2489 die("'$module' needs authentification, but Digest::MD4 is not installed\n") unless $have_md4; 2490 $user = "nobody" if !defined($user) || $user eq ''; 2491 $password = '' unless defined $password; 2492 my $digest = "$user ".Digest::MD4::md4_base64("\0\0\0\0$password".substr($buf, 18))."\n"; 2493 swrite(*S, $digest); 2494 next; 2495 } 2496 } 2497 my @args = ('--server', '--sender', '-rl'); 2498 push @args, '--exclude=/*/*' if $norecurse; 2499 for my $arg (@args, '.', "$syncroot/.", '') { 2500 swrite(*S, "$arg\n"); 2501 } 2502 $rsync_checksum_seed = unpack('V', sread(*S, 4)); 2503 swrite(*S, "\0\0\0\0"); 2504 my @filelist; 2505 my $name = ''; 2506 my $mtime = 0; 2507 my $mode = 0; 2508 my $uid = 0; 2509 my $gid = 0; 2510 my $flags; 2511 while(1) { 2512 $flags = muxread(*S, 1); 2513 $flags = ord($flags); 2514 # printf "flags = %02x\n", $flags; 2515 last if $flags == 0; 2516 $flags |= ord(muxread(*S, 1)) << 8 if $rsync_protocol >= 28 && ($flags & 0x04) != 0; 2517 my $l1 = $flags & 0x20 ? ord(muxread(*S, 1)) : 0; 2518 my $l2 = $flags & 0x40 ? unpack('V', muxread(*S, 4)) : ord(muxread(*S, 1)); 2519 $name = substr($name, 0, $l1).muxread(*S, $l2); 2520 my $len = unpack('V', muxread(*S, 4)); 2521 if ($len == 0xffffffff) { 2522 $len = unpack('V', muxread(*S, 4)); 2523 my $len2 = unpack('V', muxread(*S, 4)); 2524 $len += $len2 * 4294967296; 2525 } 2526 $mtime = unpack('V', muxread(*S, 4)) unless $flags & 0x80; 2527 $mode = unpack('V', muxread(*S, 4)) unless $flags & 0x02; 2528 my $id = "$mtime/$len/"; 2529 my @info = (); 2530 my $mmode = $mode & 07777; 2531 if (($mode & 0170000) == 0100000) { 2532 @info = ('x'); 2533 $mmode |= 0x1000; 2534 } elsif (($mode & 0170000) == 0040000) { 2535 $mmode |= 0x0000; 2536 } elsif (($mode & 0170000) == 0120000) { 2537 $mmode |= 0x2000; 2538 my $ln = muxread(*S, unpack('V', muxread(*S, 4))); 2539 @info = (Digest::MD5::md5_hex($ln)); 2540 $id .= "$ln/"; 2541 } else { 2542 print "$name: unknown mode: $mode\n"; 2543 next; 2544 } 2545 push @filelist, [$name, $id, sprintf("%04x%08x", $mmode, $mtime), @info]; 2546 } 2547 my $io_error = unpack('V', muxread(*S, 4)); 2548 @filelist = sort {$a->[0] cmp $b->[0]} @filelist; 2549 my $fidx = 0; 2550 $_->[1] .= $fidx++ for @filelist; 2551 $newstamp1 = $newstamp2 = sprintf("%08x", time); 2552 return grep {$_->[0] ne '.'} @filelist; 2553} 2554 2555sub rsync_adapt_filelist { 2556 my $fl = shift; 2557 my %c; 2558 for (@files) { 2559 my $i = $_->[1]; 2560 $i =~ s/[^\/]+$//; 2561 $c{$i} = $_; 2562 } 2563 for (@$fl) { 2564 next if @$_ == 3 || $_->[3] ne 'x'; 2565 my $i = $_->[1]; 2566 $i =~ s/[^\/]+$//; 2567 next unless $c{$i}; 2568 my @info = @{$c{$i}}; 2569 splice(@info, 0, 3); 2570 splice(@$_, 3, 1, @info); 2571 } 2572} 2573 2574sub rsync_get_update { 2575 my ($dto, $tmpnam, $reqext, $rextract) = @_; 2576 2577 die("rextract in RSYNC transport\n") if $rextract; 2578 my $fidx = $dto->[1]; 2579 if ($dto->[2] =~ /^2/) { 2580 $fidx =~ s/^[^\/]*\/[^\/]*\///s; 2581 $fidx =~ s/\/[^\/]*$//s; 2582 symlink($fidx, $tmpnam) || die("symlink: $!\n"); 2583 my @s = lstat($tmpnam); 2584 die("$tmpnam: $!\n") unless @s; 2585 return 'FILE', [ $dto->[0], "$s[9]/$s[7]/$s[1]", sprintf("2%03x%08x", ($s[2] & 07777), $s[9]), linkinfo($tmpnam) ]; 2586 } 2587 $fidx =~ s/.*\///; 2588 swrite(*S, pack('V', $fidx)); 2589 swrite(*S, ("\0\0\0\0" x ($rsync_protocol >= 27 ? 4 : 3))); 2590 my $rfidx = unpack('V', muxread(*S, 4)); 2591 die("rsync file mismatch $rfidx - $fidx\n") if $rfidx != $fidx; 2592 my $sumhead = muxread(*S, 4 * ($rsync_protocol >= 27 ? 4 : 3)); 2593 my $md4ctx; 2594 $md4ctx = Digest::MD4->new if $have_md4; 2595 $md4ctx->add(pack('V', $rsync_checksum_seed)) if $have_md4; 2596 local *OF; 2597 open(OF, '>', $tmpnam) || die("$tmpnam: $!\n"); 2598 while(1) { 2599 my $l = unpack('V', muxread(*S, 4)); 2600 last if $l == 0; 2601 die("received negative token\n") if $l < 0; 2602 my $chunk = muxread(*S, $l); 2603 $md4ctx->add($chunk) if $have_md4; 2604 syswrite(OF, $chunk) == $l || die("syswrite: $!\n"); 2605 } 2606 close(OF) || die("close: $!\n"); 2607 my $md4sum = muxread(*S, 16); 2608 if ($have_md4) { 2609 die("data corruption on net\n") if unpack("H32", $md4sum) ne $md4ctx->hexdigest(); 2610 } 2611 fixmodetime($tmpnam, $dto->[2]); 2612 my @s = lstat($tmpnam); 2613 die("$tmpnam: $!\n") unless @s; 2614 if ($dto->[0] =~ /\.[sr]pm$/) { 2615 return 'RPM ', [ $dto->[0], "$s[9]/$s[7]/$s[1]", sprintf("1%03x%08x", ($s[2] & 07777), $s[9]), rpminfo($tmpnam) ]; 2616 } else { 2617 return 'FILE', [ $dto->[0], "$s[9]/$s[7]/$s[1]", sprintf("1%03x%08x", ($s[2] & 07777), $s[9]), fileinfo($tmpnam) ]; 2618 } 2619} 2620 2621sub rsync_send_fin { 2622 swrite(*S, pack('V', -1)); # switch to phase 2 2623 swrite(*S, pack('V', -1)); # switch to phase 3 2624 if ($rsync_protocol >= 24) { 2625 swrite(*S, pack('V', -1)); # goodbye 2626 } 2627 close(S); 2628} 2629 2630####################################################################### 2631# drpmsync protocol 2632####################################################################### 2633 2634my $sock_isopen; 2635 2636sub tolength { 2637 local (*SOCK) = shift; 2638 my ($ans, $l) = @_; 2639 while (length($ans) < $l) { 2640 die("received truncated answer\n") if !sysread(SOCK, $ans, $l - length($ans), length($ans)); 2641 } 2642 return $ans; 2643} 2644 2645sub copytofile { 2646 return copytofile_seek($_[0], $_[1], 0, $_[2], $_[3], $_[4]); 2647} 2648 2649sub copytofile_seek { 2650 local (*SOCK) = shift; 2651 my ($fn, $extractoff, $ans, $l, $ctx) = @_; 2652 2653 local *FD; 2654 if ($extractoff) { 2655 open(FD, '+<', $fn) || die("$fn: $!\n"); 2656 defined(sysseek(FD, $extractoff, 0)) || die("sysseek: $!\n"); 2657 } else { 2658 open(FD, '>', $fn) || die("$fn: $!\n"); 2659 } 2660 my $al = length($ans); 2661 if ($al >= $l) { 2662 die("$fn: write error\n") if syswrite(FD, $ans, $l) != $l; 2663 die("$fn: write error\n") unless close(FD); 2664 $ctx->add(substr($ans, 0, $l)); 2665 return substr($ans, $l); 2666 } 2667 if ($al > 0) { 2668 die("$fn: write error\n") if syswrite(FD, $ans, $al) != $al; 2669 $ctx->add($ans); 2670 $l -= $al; 2671 $ans = ''; 2672 } 2673 while ($l > 0) { 2674 die("received truncated answer\n") if !sysread(SOCK, $ans, $l > 8192 ? 8192 : $l, 0); 2675 $al = length($ans); 2676 die("$fn: write error\n") if syswrite(FD, $ans, $al) != $al; 2677 $ctx->add($ans); 2678 $l -= $al; 2679 $ans = ''; 2680 } 2681 die("$fn: write error\n") unless close(FD); 2682 return ''; 2683} 2684 2685sub opensock { 2686 return if $sock_isopen; 2687 my $tcpproto = getprotobyname('tcp'); 2688 socket(S, PF_INET, SOCK_STREAM, $tcpproto) || die("socket: $!\n"); 2689 connect(S, sockaddr_in($syncport, $syncaddr)) || die("connect: $!\n"); 2690 $sock_isopen = 1; 2691} 2692 2693sub finishreq { 2694 local (*SOCK) = shift; 2695 my ($ans, $ctx, $id) = @_; 2696 2697 if ($ctx) { 2698 $ans = tolength(*SOCK, $ans, 32); 2699 my $netmd5 = substr($ans, 0, 32); 2700 die("network error: bad md5 digest\n") if $netmd5 =~ /[^a-f0-9]/; 2701 my $md5 = $ctx->hexdigest; 2702 die("network error: $md5 should be $netmd5\n") if $md5 ne $netmd5; 2703 $ans = substr($ans, 32); 2704 } 2705 alarm(0) if $config_timeout; 2706 if ($have_time_hires && defined($net_start_tv)) { 2707 $net_spent_time += Time::HiRes::tv_interval($net_start_tv); 2708 $net_recv_bytes += $rvbytes - $net_start_rvbytes; 2709 $net_start_rvbytes = $rvbytes; 2710 undef $net_start_tv; 2711 } 2712 if ($id && ($id ne 'DRPMSYNK' || length($ans))) { 2713 close(SOCK); 2714 undef $sock_isopen; 2715 } 2716 return $ans; 2717} 2718 2719sub drpmsync_get_syncfiles { 2720 my ($norecurse, $filelist_data) = @_; 2721 2722 my $data; 2723 if (defined($filelist_data)) { 2724 $data = $filelist_data; 2725 goto use_filelist_data; 2726 } 2727 alarm($config_timeout) if $config_timeout; 2728 opensock() unless $sock_isopen; 2729 my $opts = ''; 2730 $opts .= '&zlib' if $have_zlib; 2731 $opts .= '&norecurse' if $norecurse; 2732 if (@filter_comp) { 2733 my @fc = @filter_comp; 2734 while (@fc) { 2735 splice(@fc, 0, 2); 2736 my $r = shift @fc; 2737 $r =~ s/([\000-\040<>\"#&\+=%[\177-\377])/sprintf("%%%02X",ord($1))/sge; 2738 $opts .= "&filter=$r"; 2739 } 2740 } 2741 if (@filter_arch_comp) { 2742 my @fc = @filter_arch_comp; 2743 while (@fc) { 2744 splice(@fc, 0, 2); 2745 my $r = shift @fc; 2746 $r =~ s/([\000-\040<>\"#&\+=%[\177-\377])/sprintf("%%%02X",ord($1))/sge; 2747 $opts .= "&filter_arch=$r"; 2748 } 2749 } 2750 my $query = "GET $esyncroot/drpmsync/contents?drpmsync$opts HTTP/1.0\r\nHost: $synchost\r\n\r\n"; 2751 $txbytes += length($query); 2752 (syswrite(S, $query, length($query)) || 0) == length($query) || die("network write failed\n"); 2753 my $ans = ''; 2754 do { 2755 die("received truncated answer\n") if !sysread(S, $ans, 1024, length($ans)); 2756 } while ($ans !~ /\n\r?\n/s); 2757 $rvbytes += length($ans); 2758 $ans =~ /\n\r?\n(.*)$/s; 2759 $rvbytes -= length($1); 2760 $ans = tolength(*S, $1, 32); 2761 my $id = substr($ans, 0, 8); 2762 die("received bad answer\n") if $id ne 'DRPMSYNC' && $id ne 'DRPMSYNK'; 2763 my $vers = hex(substr($ans, 8, 4)); 2764 die("answer has bad version\n") if $vers != 1; 2765 my $type = substr($ans, 12, 4); 2766 if ($type eq 'ERR ') { 2767 my $anssize = hex(substr($ans, 24, 8)); 2768 $ans = tolength(*S, $ans, 32 + $anssize); 2769 die("remote error: ".substr($ans, 32, $anssize)."\n"); 2770 } 2771 die("can only sync complete trees\n") if $type eq 'GONE'; 2772 die("server send wrong answer\n") if $type ne 'SYNC' && $type ne 'SYNZ'; 2773 die("server send bad answer\n") if hex(substr($ans, 16, 8)); 2774 my $anssize = hex(substr($ans, 24, 8)); 2775 die("answer is too short\n") if $anssize < 28; 2776 $rvbytes += 32 + $anssize + 32; 2777 $ans = substr($ans, 32); 2778 $ans = tolength(*S, $ans, $anssize); 2779 $data = substr($ans, 0, $anssize); 2780 $ans = substr($ans, $anssize); 2781 my $ctx = Digest::MD5->new; 2782 $ctx->add($data); 2783 $ans = finishreq(*S, $ans, $ctx, $id); 2784 $data = substr($data, 12); 2785 if ($type eq 'SYNZ') { 2786 die("cannot uncompress\n") unless $have_zlib; 2787 $data = Compress::Zlib::uncompress($data); 2788 } 2789use_filelist_data: 2790 my $filesnum = unpack('N', $data); 2791 # work around perl 5.8.0 bug, where "(w/a*w/a*)*" does not work 2792 my @data = unpack("x[N]".("w/a*w/a*" x ($filesnum + 1)), $data); 2793 die("bad tree start\n") if @data < 2 || length($data[1]) != 8; 2794 die("bad number of file entries\n") if @data != 2 * $filesnum + 2; 2795 $synctree = shift @data; 2796 $synctree .= '/' if $synctree ne '/'; 2797 ($newstamp1, $newstamp2) = unpack('H8H8', shift @data); 2798 my @syncfiles = (); 2799 while (@data) { 2800 my ($name, $hex) = splice @data, 0, 2; 2801 die("bad file name in list: $name\n") if "/$name/" =~ /\/(\.|\.\.|)\//; 2802 if (length($hex) == 6) { 2803 push @syncfiles, [ $name, undef, unpack('H12', $hex) ]; 2804 } elsif (length($hex) == 6 + 16) { 2805 push @syncfiles, [ $name, undef, unpack('H12H32', $hex) ]; 2806 } elsif (length($hex) >= 6 + 32 + 4) { 2807 my @l = ($name, undef, unpack('H12H64H8a*', $hex)); 2808 die("bad name.arch in file list: $l[5]\n") if $l[5] eq '.' || $l[5] eq '..' || $l[5] =~ /\//; 2809 push @syncfiles, \@l; 2810 } else { 2811 die("bad line for $name: $hex\n"); 2812 } 2813 } 2814 # validate that no entry is listed twice 2815 my %ents; 2816 my %dirs; 2817 for (@syncfiles) { 2818 die("entry $_->[0] is listed twice\n") if exists $ents{$_->[0]}; 2819 $ents{$_->[0]} = 1; 2820 if ($_->[2] =~ /^0/) { 2821 $dirs{$_->[0]} = 1; 2822 die("directory $_->[0] has bad data\n") unless @$_ == 3; 2823 } else { 2824 die("entry $_->[0] has bad data\n") unless @$_ > 3; 2825 } 2826 } 2827 # validate that all files are connected to dirs 2828 for (@syncfiles) { 2829 next unless /^(.*)\//; 2830 die("entry $_->[0] is not connected\n") unless $dirs{$1}; 2831 } 2832 return @syncfiles; 2833} 2834 2835sub drpmsync_send_fin { 2836 return unless $sock_isopen; 2837 my $query = "GET $esyncroot/drpmsync/closesock?drpmsync HTTP/1.0\r\nHost: $synchost\r\n\r\n"; 2838 $txbytes += length($query); 2839 syswrite(S, $query, length($query)) == length($query) || die("network write failed\n"); 2840 close(S); 2841 undef $sock_isopen; 2842} 2843 2844sub drpmsync_get_update { 2845 my ($dto, $tmpnam, $reqext, $rextract) = @_; 2846 2847 my $d; 2848 my $extractoff = 0; 2849 if ($rextract) { 2850 die("bad extract parameter\n") unless $rextract =~ /^([0-9a-fA-F]{2})([0-9a-fA-F]{8}):[0-9a-fA-F]{8}$/; 2851 $extractoff = hex($1) * 4294967296 + hex($2); 2852 } 2853 2854 my $req = aescape($dto->[0]); 2855 $req = "/$req?drpmsync"; 2856 $req .= "&extract=$rextract" if $rextract; 2857 $req .= $reqext if $reqext; 2858# XXX print "-> $req\n"; 2859 alarm($config_timeout) if $config_timeout; 2860 opensock() unless $sock_isopen; 2861 my $query = "GET $esyncroot$req HTTP/1.0\r\nHost: $synchost\r\n\r\n"; 2862 $txbytes += length($query); 2863 if (syswrite(S, $query, length($query)) != length($query)) { 2864 die("network write failed\n"); 2865 } 2866 $net_start_tv = [Time::HiRes::gettimeofday()] if $have_time_hires; 2867 $net_start_rvbytes = $rvbytes; 2868 my $ans = ''; 2869 do { 2870 die("received truncated answer\n") if !sysread(S, $ans, 1024, length($ans)); 2871 } while ($ans !~ /\n\r?\n/s); 2872 $rvbytes += length($ans); 2873 $ans =~ /\n\r?\n(.*)$/s; 2874 $rvbytes -= length($1); 2875 $ans = tolength(*S, $1, 32); 2876 my $id = substr($ans, 0, 8); 2877 die("received bad answer: $ans\n") if $id ne 'DRPMSYNC' && $id ne 'DRPMSYNK'; 2878 my $vers = hex(substr($ans, 8, 4)); 2879 die("answer has bad version\n") if $vers != 1; 2880 my $type = substr($ans, 12, 4); 2881 my $namelen = hex(substr($ans, 16, 8)); 2882 my $anssize = hex(substr($ans, 24, 8)); 2883 if ($anssize == 4294967295) { 2884 $ans = tolength(*S, $ans, 32 + 10); 2885 $anssize = hex(substr($ans, 32, 2)) * 4294967296 + hex(substr($ans, 32 + 2, 8)); 2886 $ans = substr($ans, 10); 2887 } 2888 $rvbytes += 32 + $namelen + $anssize + 32; 2889 if ($type eq 'ERR ') { 2890 $ans = tolength(*S, $ans, 32 + $namelen + $anssize); 2891 return $type , substr($ans, 32 + $namelen, $anssize); 2892 } 2893 $ans = tolength(*S, $ans, 32 + $namelen); 2894 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); 2895 $ans = substr($ans, 32 + $namelen); 2896 2897 if ($type eq 'GONE' || $type eq 'NODR') { 2898 $ans = finishreq(*S, $ans, undef, $id); 2899 return $type; 2900 } 2901 my $extra = ''; 2902 my $extralen = 12; 2903 $extralen = 12 + 16 if $type eq 'RPM '; 2904 2905 die("answer is too short\n") if $anssize < $extralen; 2906 my $ctx = Digest::MD5->new; 2907 my $ndrpm = 0; 2908 my $nrpm = 0; 2909 if ($extralen) { 2910 $ans = tolength(*S, $ans, $extralen); 2911 $extra = substr($ans, 0, $extralen); 2912 die("illegal extra block\n") if $extra =~ /[^a-f0-9]/; 2913 if ($type eq 'RPM ') { 2914 $ndrpm = hex(substr($extra, 12, 8)); 2915 $nrpm = hex(substr($extra, 12 + 8, 8)); 2916 die("more than one rpm?\n") if $nrpm > 1; 2917 if ($ndrpm) { 2918 $extralen += $ndrpm * (12 + 32 * 3 + 8); 2919 $ans = tolength(*S, $ans, $extralen); 2920 $extra = substr($ans, 0, $extralen); 2921 die("illegal extra block\n") if $extra =~ /[^a-f0-9]/; 2922 } 2923 } 2924 $ans = substr($ans, $extralen); 2925 $anssize -= $extralen; 2926 $ctx->add($extra); 2927 } 2928 2929 die("unexpected type $type\n") if $rextract && $type ne 'RPM '; 2930 2931 if ($type eq 'FILZ') { 2932 die("cannot uncompress\n") unless $have_zlib; 2933 $ans = tolength(*S, $ans, $anssize); 2934 my $data = substr($ans, 0, $anssize); 2935 $ctx->add($data); 2936 $ans = finishreq(*S, substr($ans, $anssize), $ctx, $id); 2937 $data = Compress::Zlib::uncompress($data); 2938 my $datamd5 = Digest::MD5::md5_hex($data); 2939 if ($dto->[2] =~ /^2/) { 2940 symlink($data, $tmpnam) || die("symlink: $!\n"); 2941 } else { 2942 open(FD, '>', $tmpnam) || die("$tmpnam: $!\n"); 2943 die("$tmpnam: write error\n") if (syswrite(FD, $data) || 0) != length($data); 2944 close(FD) || die("$tmpnam: $!\n"); 2945 fixmodetime($tmpnam, substr($extra, 0, 12)); 2946 } 2947 my @s = lstat($tmpnam); 2948 die("$tmpnam: $!\n") unless @s; 2949 if ($dto->[2] =~ /^2/) { 2950 $d = [ $dto->[0], "$s[9]/$s[7]/$s[1]", sprintf("2%03x%08x", ($s[2] & 07777), $s[9]), linkinfo($tmpnam) ]; 2951 } else { 2952 $d = [ $dto->[0], "$s[9]/$s[7]/$s[1]", sprintf("1%03x%08x", ($s[2] & 07777), $s[9]), $datamd5 ]; 2953 } 2954 return ('FILZ', $d); 2955 } elsif ($type eq 'FILE') { 2956 if ($dto->[2] =~ /^2/) { 2957 $ans = tolength(*S, $ans, $anssize); 2958 $ctx->add(substr($ans, 0, $anssize)); 2959 symlink(substr($ans, 0, $anssize), $tmpnam) || die("symlink: $!\n"); 2960 $ans = substr($ans, $anssize); 2961 } else { 2962 $ans = copytofile(*S, $tmpnam, $ans, $anssize, $ctx); 2963 } 2964 $ans = finishreq(*S, $ans, $ctx, $id); 2965 fixmodetime($tmpnam, substr($extra, 0, 12)) if $dto->[2] !~ /^2/; 2966 my @s = lstat($tmpnam); 2967 die("$tmpnam: $!\n") unless @s; 2968 if ($dto->[2] =~ /^2/) { 2969 $d = [ $dto->[0], "$s[9]/$s[7]/$s[1]", sprintf("2%03x%08x", ($s[2] & 07777), $s[9]), linkinfo($tmpnam) ]; 2970 } else { 2971 $d = [ $dto->[0], "$s[9]/$s[7]/$s[1]", sprintf("1%03x%08x", ($s[2] & 07777), $s[9]), fileinfo($tmpnam) ]; 2972 } 2973 return ('FILE', $d); 2974 } elsif ($type eq 'FISO') { 2975 $ans = copytofile(*S, "$tmpnam.fiso", $ans, $anssize, $ctx); 2976 $ans = finishreq(*S, $ans, $ctx, $id); 2977 return 'FISO', [ $tmpnam, undef, substr($extra, 0, 12) ]; 2978 } elsif ($type eq 'RPM ') { 2979 $sabytes -= $anssize; 2980 my $delta; 2981 die("more than one rpm?\n") if $nrpm > 1; 2982 die("nothing to do?\n") if $nrpm == 0 && $ndrpm == 0; 2983 my @deltas; 2984 my $dextra = substr($extra, 12 + 16); 2985 while ($ndrpm > 0) { 2986 $delta = $tmpnam; 2987 $delta =~ s/[^\/]*$//; 2988 $delta .= substr($dextra, 12, 32 * 3); 2989 # end old job if we have a delta conflict 2990 checkjob() if $runningjob && -e $delta; 2991 my $size = hex(substr($dextra, 12 + 3 * 32, 8)); 2992 die("delta rpm bigger than answer? $size > $anssize\n") if $size > $anssize; 2993 $ans = copytofile(*S, $delta, $ans, $size, $ctx); 2994 $anssize -= $size; 2995 fixmodetime($delta, substr($dextra, 0, 12)); 2996 $dextra = substr($dextra, 12 + 32 * 3 + 8); 2997 push @deltas, $delta; 2998 $ndrpm--; 2999 } 3000 if ($nrpm == 1) { 3001 $ans = copytofile_seek(*S, $tmpnam, $extractoff, $ans, $anssize, $ctx); 3002 $ans = finishreq(*S, $ans, $ctx, $id); 3003 return 'RPM ', [ $dto->[0] ], @deltas if $rextract; 3004 fixmodetime($tmpnam, substr($extra, 0, 12)); 3005 my @s = stat($tmpnam); 3006 die("$tmpnam: $!\n") unless @s; 3007 $sabytes += $s[7]; 3008 $d = [ $dto->[0], "$s[9]/$s[7]/$s[1]", sprintf("1%03x%08x", ($s[2] & 07777), $s[9]), rpminfo($tmpnam) ]; 3009 } else { 3010 die("junk at end of answer\n") if $anssize; 3011 $ans = finishreq(*S, $ans, $ctx, $id); 3012 $d = [ undef, undef, substr($extra, 0, 12) ]; 3013 } 3014 return 'RPM ', $d, @deltas; 3015 } else { 3016 die("received strange answer type: $type\n"); 3017 } 3018} 3019 3020 3021####################################################################### 3022# update functions 3023####################################################################### 3024 3025sub save_or_delete_deltas { 3026 my ($bdir, $dpn, @deltas) = @_; 3027 3028 if (!$config_keep_deltas || !$dpn) { 3029 for my $delta (@deltas) { 3030 unlink($delta) || die("unlink $delta: $!\n"); 3031 } 3032 return; 3033 } 3034 my $ddir = "$bdir/drpmsync/deltas/$dpn"; 3035 mkdir_p($ddir); 3036 for my $delta (@deltas) { 3037 my $dn = $delta; 3038 $dn =~ s/.*\///; 3039 if (substr($dn, 0, 32) eq substr($dn, 64, 32)) { 3040 # print("detected signature-only delta\n"); 3041 local(*DDIR); 3042 opendir(DDIR, "$ddir") || die("opendir $ddir: $!\n"); 3043 my @dh = grep {$_ =~ /^[0-9a-f]{96}$/} readdir(DDIR); 3044 closedir(DDIR); 3045 @dh = grep {substr($_, 64, 32) eq substr($dn, 64, 32)} @dh; 3046 @dh = grep {substr($_, 32, 32) ne substr($dn, 32, 32)} @dh; 3047 for my $dh (@dh) { 3048 # recvlog_print("! $dh"); 3049 my $nn = substr($dh, 0, 32).substr($dn, 32, 64); 3050 my @oldstat = stat("$ddir/$dh"); 3051 die("$ddir/$dh: $!") unless @oldstat; 3052 if (system($combinedeltarpm, "$ddir/$dh", $delta, "$bdir/drpmsync/wip/$nn") || ! -f "$bdir/drpmsync/wip/$nn") { 3053 recvlog_print("! combinedeltarpm $ddir/$dh $delta $bdir/drpmsync/wip/$nn failed"); 3054 unlink("$bdir/drpmsync/wip/$nn"); 3055 next; 3056 } 3057 utime($oldstat[9], $oldstat[9], "$bdir/drpmsync/wip/$nn"); 3058 rename("$bdir/drpmsync/wip/$nn", "$ddir/$nn") || die("rename $bdir/drpmsync/wip/$nn $ddir/$nn: $!\n"); 3059 unlink("$bdir/drpmsync/deltas/$dpn/$dh") || die("unlink $bdir/drpmsync/deltas/$dpn/$dh: $!\n"); 3060 } 3061 unlink($delta) || die("unlink $delta: $!\n"); 3062 } else { 3063 rename($delta, "$ddir/$dn") || die("rename $delta $ddir/$dn: $!\n"); 3064 } 3065 } 3066} 3067 3068 3069# get rpms for fiso, fill iso 3070 3071sub update_fiso { 3072 my ($bdir, $pn, $dto, $rights) = @_; 3073 3074 local *F; 3075 if (!open(F, '-|', $fragiso, 'list', "$bdir/drpmsync/wip/$pn.fiso")) { 3076 unlink("$bdir/drpmsync/wip/$pn.fiso"); 3077 return undef; 3078 } 3079 my @frags = <F>; 3080 close(F) || return undef; 3081 chomp @frags; 3082 open(F, '>', "$bdir/drpmsync/wip/$pn") || die("$bdir/drpmsync/wip/$pn: $!\n"); 3083 close(F); 3084 for my $f (@frags) { 3085 my @f = split(' ', $f, 3); 3086 update($bdir, [ $dto->[0], undef, $rights, $f[1], undef, $f[2] ], $f[0]); 3087 } 3088 checkjob() if $runningjob; 3089 my ($md5, $err) = runprg(undef, undef, $fragiso, 'fill', '-m', "$bdir/drpmsync/wip/$pn.fiso", "$bdir/drpmsync/wip/$pn"); 3090 unlink("$bdir/drpmsync/wip/$pn.fiso") || die("unlink $bdir/drpmsync/wip/$pn.fiso: $!\n");; 3091 my $tmpnam = "$bdir/drpmsync/wip/$pn"; 3092 if ($err) { 3093 recvlog_print("! fragiso fill failed: $err"); 3094 unlink($tmpnam); 3095 return undef; 3096 } 3097 die("fragiso did not return md5\n") unless $md5 =~ /^[0-9a-f]{32}$/; 3098 fixmodetime($tmpnam, $rights); 3099 my @s = lstat($tmpnam); 3100 die("$tmpnam: $!\n") unless @s; 3101 $rights = sprintf("1%03x%08x", ($s[2] & 07777), $s[9]); 3102 $files{$dto->[0]} = [ $dto->[0], "$s[9]/$s[7]/$s[1]", $rights, $md5 ]; 3103 rename($tmpnam, "$bdir/$dto->[0]") || die("rename $tmpnam $bdir/$dto->[0]: $!\n"); 3104 if ($config_repo) { 3105 for my $f (@frags) { 3106 my @f = split(' ', $f, 3); 3107 repo_add("$bdir/$dto->[0]\@$f[0]", [ "$dto->[0]\@$f[0]", "$s[9]/$s[7]/$s[1]", $rights, $f[1], undef, $f[2] ] ); 3108 } 3109 } 3110 return 1; 3111} 3112 3113 3114# called for files and rpms 3115 3116sub update { 3117 my ($bdir, $dto, $rextract, $play_it_safe) = @_; 3118 3119 my ($d, $nd, $md); 3120 my $pdto0; 3121 my @deltas; 3122 my $extractoff; 3123 my $tmpnam; 3124 3125 if ($play_it_safe && ref($play_it_safe)) { 3126 # poor mans co-routine implementation... 3127 my $job = $play_it_safe; 3128 $d = $job->{'d'}; 3129 $nd = $job->{'nd'}; 3130 $md = $job->{'md'}; 3131 $pdto0 = $job->{'pdto0'}; 3132 $tmpnam = $job->{'tmpnam'}; 3133 $extractoff = $job->{'extractoff'}; 3134 @deltas = applydeltas_finish($job); 3135 goto applydeltas_finished; 3136 } 3137 3138 die("can only update files and symlinks\n") if $dto->[2] !~ /^[12]/; 3139 $pdto0 = $dto->[0]; # for recvlog_print; 3140 3141 # hack: patch source/dest for special fiso request 3142 if ($rextract) { 3143 die("bad extract parameter\n") unless $rextract =~ /^([0-9a-fA-F]{2})([0-9a-fA-F]{8}):[0-9a-fA-F]{8}$/; 3144 $extractoff = hex($1) * 4294967296 + hex($2); 3145 die("bad extract offset\n") unless $extractoff; 3146 $pdto0 = "$dto->[0]\@$rextract ($dto->[5])"; 3147 } 3148 3149 $d = $files{$dto->[0]}; 3150 if ($d && !$rextract && $d->[3] eq $dto->[3]) { 3151 return if $d->[2] eq $dto->[2]; # already identical 3152 if (substr($d->[2], 0, 1) eq substr($dto->[2], 0, 1)) { 3153 return if substr($d->[2], 0, 1) eq '2'; # can't change links 3154 fixmodetime("$bdir/$d->[0]", $dto->[2]); 3155 $d->[2] = $dto->[2]; 3156 my $newmtime = hex(substr($dto->[2], 4, 8)); 3157 $d->[1] =~ s/^.*?\//$newmtime\//; # patch cache id 3158 return; 3159 } 3160 } 3161 3162 # check for simple renames 3163 if (!$d && !$rextract && substr($dto->[2], 0, 1) eq '1') { 3164 # search for same md5, same mtime and removed files 3165 my @oldds = grep {@$_ > 3 && $_->[3] eq $dto->[3] && substr($_->[2], 4) eq substr($dto->[2], 4) && !$syncfiles{$_->[0]}} values %files; 3166 if (@oldds) { 3167 $d = $oldds[0]; 3168 my $pn = $dto->[0]; 3169 $pn =~ s/.*\///; 3170 $tmpnam = "$bdir/drpmsync/wip/$pn"; 3171 checkjob($pn) if $runningjob; 3172 # rename it 3173 if (rename("$bdir/$d->[0]", $tmpnam)) { 3174 delete $files{$d->[0]}; 3175 recvlog_print("- $d->[0]"); 3176 repo_del("$bdir/$d->[0]", $d) if $config_repo; 3177 my @s = stat($tmpnam); 3178 # check link count, must be 1 3179 if (!@s || $s[3] != 1) { 3180 unlink($tmpnam); # oops 3181 } else { 3182 fixmodetime($tmpnam, $dto->[2]); 3183 @s = stat($tmpnam); 3184 die("$tmpnam: $!\n") unless @s; 3185 my @info = @$d; 3186 splice(@info, 0, 3); 3187 $files{$dto->[0]} = [ $dto->[0], "$s[9]/$s[7]/$s[1]", sprintf("1%03x%08x", ($s[2] & 07777), $s[9]), @info ]; 3188 recvlog_print("M $dto->[0]"); 3189 rename($tmpnam, "$bdir/$dto->[0]") || die("rename $tmpnam $bdir/$dto->[0]: $!\n"); 3190 repo_add("$bdir/$dto->[0]", $files{$dto->[0]}) if $config_repo; 3191 # no need to create delta, as file was already in tree... 3192 return; 3193 } 3194 } 3195 undef $d; 3196 } 3197 } 3198 3199 if (!$d && @$dto > 5) { 3200 my @oldds = grep {@$_ > 5 && $_->[5] eq $dto->[5]} values %files; 3201 $d = $oldds[0] if @oldds; 3202 } 3203 3204 $md = $d; # make delta against this entry ($d may point to repo) 3205 my $repo_key = ''; 3206 my @repo; 3207 my $deltaonly; 3208 3209 if ($config_repo && @$dto > 5) { 3210 @repo = repo_search($dto->[5], $dto->[3]); 3211 # we must not use the repo if we need to store the deltas. 3212 # in this case we will send a delta-only request and retry the 3213 # repo if it fails 3214 if (@repo && !$rextract && !$config_generate_deltas && $config_keep_deltas) { 3215 @repo = repo_check(@repo); 3216 $deltaonly = 1 if @repo; 3217 } 3218 } 3219 3220################################################################## 3221################################################################## 3222 3223send_again: 3224 3225 while (@repo && !$deltaonly) { 3226 my $rd; 3227 my $pn = $dto->[0]; 3228 $pn =~ s/^.*\///; 3229 checkjob($pn) if $runningjob; 3230 if ($repo[0]->[0] eq $dto->[3]) { 3231 # exact match, great! 3232 $tmpnam = "$bdir/drpmsync/wip/$pn"; 3233 $rd = repo_cp($repo[0], $bdir, "drpmsync/wip/$pn", $extractoff); 3234 if (!$rd) { 3235 shift @repo; 3236 next; 3237 } 3238 if ($rextract) { 3239 recvlog_print("R $pdto0"); 3240 return; 3241 } 3242 fixmodetime($tmpnam, $dto->[2]); 3243 my @s = stat($tmpnam); 3244 die("$tmpnam: $!\n") unless @s; 3245 my $oldd5 = $md ? substr($md->[3], 32) : undef; 3246 $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] ]; 3247 if ($oldd5 && $config_generate_deltas) { 3248 recvlog_print("Rm $pdto0"); 3249 @deltas = makedelta("$bdir/$md->[0]", $tmpnam, "$bdir/drpmsync/wip/$oldd5$files{$dto->[0]}->[3]"); 3250 save_or_delete_deltas($bdir, $dto->[5], @deltas); 3251 } else { 3252 recvlog_print("R $pdto0"); 3253 } 3254 rename($tmpnam, "$bdir/$dto->[0]") || die("rename $tmpnam $bdir/$dto->[0]: $!\n"); 3255 repo_add("$bdir/$dto->[0]", $files{$dto->[0]}); 3256 return; 3257 } elsif (substr($repo[0]->[0], 32, 32) eq substr($dto->[3], 32, 32)) { 3258 # have sign only rpm, copy right away 3259 checkjob() if $runningjob; 3260 $rd = repo_cp($repo[0], $bdir, "drpmsync/wip/repo-$pn"); 3261 if (!$rd) { 3262 shift @repo; 3263 next; 3264 } 3265 $d = $rd; 3266 $d->[1] = undef; # mark as temp, don't gen/save delta 3267 $repo_key = 'R'; 3268 @repo = (); 3269 } 3270 @repo = repo_check(@repo) if @repo; 3271 last; 3272 } 3273 3274 # ok, we really need to send a request our server 3275 my $reqext = ''; 3276 if (@repo && !$deltaonly && !$play_it_safe) { 3277 my @h = map {$_->[0]} @repo; 3278 unshift @h, $d->[3] if $d && @$d > 5; 3279 $reqext .= "&have=" . shift(@h); 3280 if (@h) { 3281 my %ha = map {substr($_, -32, 32) => 1} @h; 3282 $reqext .= "&havealso=" . join(',', keys %ha); 3283 } 3284 } elsif ($d && @$d > 5 && !$play_it_safe) { 3285 $reqext .= "&have=$d->[3]"; 3286 $reqext .= "&uncombined" if $config_keep_uncombined; 3287 $reqext .= "&withrpm" if $config_always_get_rpm && substr($d->[3], 32) ne substr($dto->[3], 32); 3288 $reqext .= "&deltaonly" if $deltaonly; 3289 $reqext .= "&nocomplexdelta" if (!$config_keep_deltas || $rextract) && $config_always_get_rpm; 3290 } else { 3291 $reqext .= "&zlib" if $have_zlib; 3292 $reqext .= "&fiso" if $config_repo && !$play_it_safe && ($dto->[0] =~ /(?<!\.delta)\.iso$/i); 3293 } 3294 3295 my $pn = $dto->[0]; 3296 $pn =~ s/^.*\///; 3297 die("no file name?\n") unless $pn ne ''; 3298 checkjob($pn) if $runningjob; 3299 $tmpnam = "$bdir/drpmsync/wip/$pn"; 3300 my $type; 3301 ($type, $nd, @deltas) = get_update($dto, $tmpnam, $reqext, $rextract); 3302 if ($type eq 'ERR ') { 3303 die("$nd\n"); 3304 } elsif ($type eq 'NODR') { 3305 die("unexpected NODR answer\n") unless $deltaonly; 3306 $deltaonly = 0; 3307 goto send_again; 3308 } elsif ($type eq 'GONE') { 3309 warn("$dto->[0] is gone\n"); 3310 recvlog_print("${repo_key}G $pdto0"); 3311 if (-e "$bdir/$dto->[0]") { 3312 unlink("$bdir/$dto->[0]") || die("unlink $bdir/$dto->[0]: $!\n"); 3313 } 3314 delete $files{$dto->[0]}; 3315 $had_gone = 1; 3316 } elsif ($type eq 'FILZ') { 3317 recvlog_print("${repo_key}z $pdto0"); 3318 rename($tmpnam, "$bdir/$dto->[0]") || die("rename $tmpnam $bdir/$dto->[0]: $!\n"); 3319 $files{$dto->[0]} = $nd; 3320 } elsif ($type eq 'FILE') { 3321 recvlog_print("${repo_key}f $pdto0"); 3322 rename($tmpnam, "$bdir/$dto->[0]") || die("rename $tmpnam $bdir/$dto->[0]: $!\n"); 3323 $files{$dto->[0]} = $nd; 3324 } elsif ($type eq 'FISO') { 3325 checkjob() if $runningjob; 3326 recvlog_print("${repo_key}i $pdto0"); 3327 if (!update_fiso($bdir, $pn, $dto, $nd->[2])) { 3328 $play_it_safe = 1; 3329 goto send_again; 3330 } 3331 } elsif ($type eq 'RPM ') { 3332 if (!$nd->[0]) { 3333 checkjob() if $runningjob; 3334 die("no deltas?") unless @deltas; 3335 undef $d if $d && (@$d <= 4 || substr($d->[3], 32, 32) ne substr($deltas[0], -96, 32)); 3336 if (!$d && @repo) { 3337 my $dmd5 = substr($deltas[0], -96, 32); 3338 my @mrepo = grep {substr($_->[0], 32, 32) eq $dmd5} @repo; 3339 for my $rd (@mrepo) { 3340 $d = repo_cp($rd, $bdir, "drpmsync/wip/repo-$pn"); 3341 last if $d; 3342 } 3343 if (!$d && @mrepo) { 3344 recvlog_print("R! $pdto0"); 3345 save_or_delete_deltas($bdir, undef, @deltas); 3346 @repo = grep {substr($_->[0], 32, 32) ne $dmd5} @repo; 3347 goto send_again; # now without bad repo entries 3348 } 3349 $d->[1] = undef if $d; 3350 $repo_key = 'R'; 3351 } 3352 if (@deltas == 1 && substr($deltas[0], -96, 32) eq substr($deltas[0], -32, 32)) { 3353 recvlog_print("${repo_key}s $pdto0"); 3354 } else { 3355 recvlog_print("${repo_key}d $pdto0"); 3356 } 3357 die("received delta doesn't match request\n") unless $d; 3358 3359####################################################################### 3360 3361 if (1) { 3362 my $job = {}; 3363 $job->{'d'} = $d; 3364 $job->{'nd'} = $nd; 3365 $job->{'md'} = $md; 3366 $job->{'pdto0'} = $pdto0; 3367 $job->{'tmpnam'} = $tmpnam; 3368 $job->{'extractoff'} = $extractoff; 3369 $job->{'wip'} = $pn; 3370 $job->{'finish'} = \&update; 3371 $job->{'finishargs'} = [$bdir, $dto, $rextract, $job]; 3372 @deltas = applydeltas($job, "$bdir/$d->[0]", $tmpnam, $extractoff, @deltas); 3373 if (@deltas) { 3374 $runningjob = $job; 3375 return; 3376 } 3377 delete $job->{'finishargs'}; # break circ ref 3378 } 3379 3380####################################################################### 3381 3382 #recvlog("applying deltarpm to $d->[0]"); 3383 #@deltas = applydeltas("$bdir/$d->[0]", $tmpnam, $extractoff, @deltas); 3384applydeltas_finished: 3385 if (!@deltas) { 3386 return update($bdir, $dto, $rextract, 1); 3387 } 3388 if (!$rextract) { 3389 fixmodetime($tmpnam, $nd->[2]); 3390 my @s = stat($tmpnam); 3391 die("$tmpnam: $!\n") unless @s; 3392 $sabytes += $s[7]; 3393 $nd = [ $dto->[0], "$s[9]/$s[7]/$s[1]", sprintf("1%03x%08x", ($s[2] & 07777), $s[9]), rpminfo($tmpnam) ]; 3394 } 3395 } else { 3396 recvlog_print("${repo_key}r $pdto0") if $rextract || !(!@deltas && $md && $md->[1] && $config_generate_deltas); 3397 } 3398 if ($rextract) { 3399 save_or_delete_deltas($bdir, undef, @deltas); 3400 unlink("$bdir/$d->[0]") if $d && ($d->[0] =~ m!drpmsync/wip/repo-!); 3401 return; 3402 } 3403 if (@deltas && $d && !$d->[1]) { 3404 # deltas made against some repo rpm, always delete 3405 save_or_delete_deltas($bdir, undef, @deltas); 3406 @deltas = (); 3407 } 3408 if (!@deltas && $md && $md->[1] && $config_generate_deltas) { 3409 recvlog_print("${repo_key}m $pdto0"); 3410 @deltas = makedelta("$bdir/$md->[0]", $tmpnam, "$bdir/drpmsync/wip/".substr($md->[3], 32).$nd->[3]); 3411 } 3412 save_or_delete_deltas($bdir, $dto->[5], @deltas); 3413 3414 rename($tmpnam, "$bdir/$dto->[0]") || die("rename $tmpnam $bdir/$dto->[0]: $!\n"); 3415 $files{$dto->[0]} = $nd; 3416 repo_add("$bdir/$dto->[0]", $nd) if $config_repo; 3417 } else { 3418 die("received strange answer type: $type\n"); 3419 } 3420 unlink("$bdir/$d->[0]") if $d && ($d->[0] =~ m!drpmsync/wip/repo-!); 3421} 3422 3423sub fixmodetime { 3424 my ($fn, $mthex) = @_; 3425 my $mode = hex(substr($mthex, 1, 3)); 3426 my $ti = hex(substr($mthex, 4, 8)); 3427 chmod($mode, $fn) == 1 || die("chmod $fn: $!\n"); 3428 utime($ti, $ti, $fn) == 1 || die("utime $fn: $!\n"); 3429} 3430 3431my $cmdline_cf; 3432my $cmdline_source; 3433my $cmdline_repo; 3434my $cmdline_repo_add; 3435my $cmdline_repo_validate; 3436my $cmdline_get_filelist; 3437my $cmdline_use_filelist; 3438my $cmdline_norecurse; 3439my $cmdline_list; 3440my @cmdline_filter; 3441my @cmdline_filter_arch; 3442 3443sub find_source { 3444 my ($syncfilesp, $norecurse, $verbose, @sources) = @_; 3445 my %errors; 3446 3447 if (!@sources) { 3448 setup_proto('null'); 3449 @$syncfilesp = (); 3450 return; 3451 } 3452 for my $s (@sources) { 3453 $syncurl = $s; 3454 my $ss = $s; 3455 $syncproto = 'drpmsync'; 3456 if ($ss =~ /^(file|drpmsync|rsync):(.*)$/) { 3457 $syncproto = lc($1); 3458 $ss = $2; 3459 if ($syncproto ne 'file') { 3460 $ss =~ s/^\/\///; 3461 if ($ss =~ /^([^\/]+)\@(.*)$/) { 3462 $syncuser = $1; 3463 $ss = $2; 3464 ($syncuser, $syncpassword) = split(':', $syncuser, 2); 3465 } 3466 } 3467 } 3468 if ($syncproto eq 'file') { 3469 $syncroot = $ss; 3470 $syncroot =~ s/\/\.$//; 3471 $syncroot =~ s/\/$// unless $syncroot eq '/'; 3472 } else { 3473 ($syncaddr, $syncport, $syncroot) = $ss =~ /^([^\/]+?)(?::(\d+))?(\/.*)$/; 3474 if (!$syncaddr) { 3475 $errors{$s} = "bad url"; 3476 next; 3477 } 3478 $syncroot =~ s/\/\.$//; 3479 $syncroot =~ s/\/$// unless $syncroot eq '/'; 3480 $esyncroot = aescape($syncroot); 3481 $syncport ||= $syncproto eq 'rsync' ? 873 : 80; 3482 $syncaddr = inet_aton($syncaddr); 3483 if (!$syncaddr) { 3484 $errors{$s} = "could not resolve host"; 3485 next; 3486 } 3487 print "trying $s\n" if $verbose; 3488 } 3489 eval { 3490 setup_proto($syncproto); 3491 @$syncfilesp = get_syncfiles($norecurse); 3492 }; 3493 alarm(0) if $config_timeout; 3494 last unless $@; 3495 $errors{$s} = "$@"; 3496 $errors{$s} =~ s/\n$//s; 3497 undef $syncaddr; 3498 } 3499 if ($syncproto ne 'file' && !$syncaddr) { 3500 if (@sources == 1) { 3501 die("could not connect to $sources[0]: $errors{$sources[0]}\n"); 3502 } else { 3503 print STDERR "could not connect to any server:\n"; 3504 print STDERR " $_: $errors{$_}\n" for @sources; 3505 exit(1); 3506 } 3507 } 3508 filelist_apply_filter($syncfilesp); 3509 filelist_apply_filter_arch($syncfilesp); 3510} 3511 3512sub filelist_from_file { 3513 my ($flp, $fn) = @_; 3514 3515 local *FL; 3516 if ($fn eq '-') { 3517 open(FL, '<&STDIN') || die("STDIN dup: $!\n"); 3518 } else { 3519 open(FL, '<', $fn) || die("$fn: $!\n"); 3520 } 3521 my $fldata; 3522 my $data; 3523 my $is_compressed; 3524 die("not a drpmsync filelist\n") if read(FL, $data, 32) != 32; 3525 if (substr($data, 0, 2) eq "\037\213") { 3526 { local $/; $data .= <FL>; } 3527 $data = Compress::Zlib::memGunzip($data); 3528 die("filelist uncompress error\n") unless defined $data; 3529 $is_compressed = 1; 3530 } 3531 die("not a drpmsync filelist\n") if (substr($data, 0, 24) ne 'DRPMSYNC0001SYNC00000000' && substr($data, 0, 24) ne 'DRPMSYNC0001SYNZ00000000'); 3532 if ($is_compressed) { 3533 $fldata = substr($data, 32); 3534 $data = substr($data, 0, 32); 3535 } else { 3536 { local $/; $fldata = <FL>; } 3537 } 3538 close FL; 3539 my $md5 = substr($fldata, -32, 32); 3540 $fldata = substr($fldata, 0, -32); 3541 die("drpmsync filelist checksum error\n") if Digest::MD5::md5_hex($fldata) ne $md5; 3542 $fldata = substr($fldata, 12); 3543 if (substr($data, 16, 4) eq 'SYNZ') { 3544 die("cannot uncompress filelist\n") unless $have_zlib; 3545 $fldata = Compress::Zlib::uncompress($fldata); 3546 } 3547 @$flp = drpmsync_get_syncfiles($cmdline_norecurse, $fldata); 3548 filelist_apply_filter($flp); 3549 filelist_apply_filter_arch($flp); 3550} 3551 3552while (@ARGV) { 3553 last if $ARGV[0] !~ /^-/; 3554 my $opt = shift @ARGV; 3555 last if $opt eq '--'; 3556 if ($opt eq '-c') { 3557 die("-c: argument required\n") unless @ARGV; 3558 $cmdline_cf = shift @ARGV; 3559 } elsif ($opt eq '--repo') { 3560 die("--repo: argument required\n") unless @ARGV; 3561 $cmdline_repo = shift @ARGV; 3562 } elsif ($opt eq '--repo-add') { 3563 $cmdline_repo_add = 1; 3564 } elsif ($opt eq '--repo-validate') { 3565 $cmdline_repo_validate = 1; 3566 } elsif ($opt eq '--norecurse-validate') { 3567 $cmdline_norecurse = 1; 3568 } elsif ($opt eq '--list') { 3569 $cmdline_list = 1; 3570 $cmdline_norecurse = 1; 3571 } elsif ($opt eq '--list-recursive') { 3572 $cmdline_list = 1; 3573 } elsif ($opt eq '--get-filelist') { 3574 die("--get-filelist: argument required\n") unless @ARGV; 3575 $cmdline_get_filelist = shift @ARGV; 3576 } elsif ($opt eq '--filelist-synctree') { 3577 $synctree = shift @ARGV; 3578 $synctree .= '/'; 3579 } elsif ($opt eq '--use-filelist') { 3580 die("--use-filelist: argument required\n") unless @ARGV; 3581 $cmdline_use_filelist = shift @ARGV; 3582 } elsif ($opt eq '--exclude') { 3583 die("--exclude: argument required\n") unless @ARGV; 3584 push @cmdline_filter, '-'.shift(@ARGV); 3585 } elsif ($opt eq '--include') { 3586 die("--include: argument required\n") unless @ARGV; 3587 push @cmdline_filter, '+'.shift(@ARGV); 3588 } elsif ($opt eq '--exclude-arch') { 3589 die("--exclude-arch: argument required\n") unless @ARGV; 3590 push @cmdline_filter_arch, '-'.shift(@ARGV); 3591 } elsif ($opt eq '--include-arch') { 3592 die("--include-arch: argument required\n") unless @ARGV; 3593 push @cmdline_filter_arch, '+'.shift(@ARGV); 3594 } else { 3595 die("$opt: unknown option\n"); 3596 } 3597} 3598 3599if ($cmdline_repo_validate) { 3600 my $basedir; 3601 $basedir = shift @ARGV if @ARGV; 3602 die("illegal source parameter for repo operation\n") if @ARGV; 3603 if (defined($cmdline_cf) || (defined($basedir) && -e "$basedir/drpmsync/config")) { 3604 readconfig_client(defined($cmdline_cf) ? $cmdline_cf : "$basedir/drpmsync/config"); 3605 } 3606 $config_repo = $cmdline_repo if defined $cmdline_repo; 3607 die("--repo-validate: no repo specified\n") unless $config_repo; 3608 repo_validate(); 3609 exit(0); 3610} 3611 3612my $basedir; 3613if (@ARGV == 2) { 3614 die("illegal source parameter for repo operation\n") if $cmdline_repo_add; 3615 $cmdline_source = shift @ARGV; 3616 $basedir = $ARGV[0]; 3617} elsif (@ARGV == 1) { 3618 if ($cmdline_list || defined($cmdline_get_filelist)) { 3619 $cmdline_source = $ARGV[0]; 3620 } else { 3621 $basedir = $ARGV[0]; 3622 } 3623} else { 3624 die("Usage: drpmsync [-c config] [source] <dir> | -s <serverconfig>\n") unless $cmdline_list && defined($cmdline_use_filelist); 3625} 3626 3627if (defined($basedir)) { 3628 if (-f $basedir) { 3629 die("$basedir: not a directory (did you forget -s?)\n"); 3630 } 3631 mkdir_p($basedir); 3632} 3633 3634if (defined($cmdline_cf)) { 3635 readconfig_client($cmdline_cf); 3636} elsif (defined($basedir) && (-e "$basedir/drpmsync/config")) { 3637 readconfig_client("$basedir/drpmsync/config"); 3638} 3639 3640@config_source = $cmdline_source if defined $cmdline_source; 3641$config_repo = $cmdline_repo if defined $cmdline_repo; 3642@filter_comp = compile_filter(@cmdline_filter, @config_filter); 3643@filter_arch_comp = compile_filter(@cmdline_filter_arch, @config_filter_arch); 3644 3645if ($config_repo && defined($basedir)) { 3646 my $nbasedir = `cd $basedir && /bin/pwd`; 3647 chomp $nbasedir; 3648 die("could not canonicalize $basedir\n") if !$nbasedir || !-d "$nbasedir"; 3649 $basedir = $nbasedir; 3650} 3651 3652if ($cmdline_repo_add) { 3653 die("--repo-add: no repo specified\n") unless $config_repo; 3654 die("need a destination\n") unless defined $basedir; 3655 readcache("$basedir/drpmsync/cache"); 3656 print "getting state of local tree...\n"; 3657 findfiles($basedir, ''); 3658 print("cache: $cachehits hits, $cachemisses misses\n"); 3659 for my $d (@files) { 3660 repo_add("$basedir/$d->[0]", $d); 3661 } 3662 exit(0); 3663} 3664 3665if (defined($cmdline_get_filelist)) { 3666 die("need a source for get-filelist\n") unless @config_source; 3667 $SIG{'ALRM'} = sub {die("network timeout\n");}; 3668 my @syncfiles; 3669 find_source(\@syncfiles, $cmdline_norecurse, $cmdline_get_filelist eq '-' ? 0 : 1, @config_source); 3670 send_fin(); 3671 filelist_from_file(\@syncfiles, $cmdline_use_filelist) if defined $cmdline_use_filelist; 3672 local *FL; 3673 if ($cmdline_get_filelist eq '-') { 3674 open(FL, '>&STDOUT') || die("STDOUT dup: $!\n"); 3675 } else { 3676 open(FL, '>', $cmdline_get_filelist) || die("$cmdline_get_filelist: $!\n"); 3677 } 3678 my $data; 3679 $data = pack('H*', "$newstamp1$newstamp2"); 3680 $data = pack("Nw/a*w/a*", scalar(@syncfiles), $synctree ne '/' ? substr($synctree, 0, -1) : '/', $data); 3681 $data = sprintf("1%03x%08x", 0644, time()).$data; 3682 for (@syncfiles) { 3683 my @l = @$_; 3684 my $b; 3685 if (@l > 5) { 3686 $b = pack('H*', "$l[2]$l[3]$l[4]").$l[5]; 3687 } elsif (@l > 3) { 3688 if ($l[3] eq 'x') { 3689 $b = pack('H*', $l[2])."\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"; 3690 } else { 3691 $b = pack('H*', "$l[2]$l[3]"); 3692 } 3693 } else { 3694 $b = pack('H*', $l[2]); 3695 } 3696 $data .= pack("w/a*w/a*", $l[0], $b); 3697 } 3698 $data = "DRPMSYNC0001SYNC00000000".sprintf("%08x", length($data)).$data.Digest::MD5::md5_hex($data); 3699 print FL $data; 3700 close(FL) || die("close: $!\n"); 3701 exit(0); 3702} 3703 3704if ($cmdline_list) { 3705 $SIG{'ALRM'} = sub {die("network timeout\n");}; 3706 my @syncfiles; 3707 find_source(\@syncfiles, $cmdline_norecurse, 0, @config_source); 3708 send_fin(); 3709 filelist_from_file(\@syncfiles, $cmdline_use_filelist) if defined $cmdline_use_filelist; 3710 for my $f (@syncfiles) { 3711 my $p = substr($f->[2], 0, 1) eq '0' ? '/' : ''; 3712 print "$f->[0]$p\n"; 3713 } 3714 exit(0); 3715} 3716 3717# get the lock 3718 3719die("need a destination\n") unless defined $basedir; 3720mkdir_p("$basedir/drpmsync"); 3721sysopen(LOCK, "$basedir/drpmsync/lock", POSIX::O_RDWR|POSIX::O_CREAT, 0666) || die("$basedir/drpmsync/lock: $!\n"); 3722if (!flock(LOCK, LOCK_EX | LOCK_NB)) { 3723 my $lockuser = ''; 3724 sysread(LOCK, $lockuser, 1024); 3725 close LOCK; 3726 $lockuser = "somebody else\n" unless $lockuser =~ /.*[\S].*\n$/s; 3727 print "update already in progress by $lockuser"; 3728 exit(1); 3729} 3730truncate(LOCK, 0); 3731syswrite(LOCK, "drpmsync[$$]\@$synchost\n"); 3732 3733my ($oldstamp1, $oldstamp2); 3734if (open(STAMP, '<', "$basedir/drpmsync/timestamp")) { 3735 my $s = ''; 3736 if ((sysread(STAMP, $s, 16) || 0) == 16 && $s !~ /[^0-9a-f]/) { 3737 $oldstamp1 = substr($s, 0, 8); 3738 $oldstamp2 = substr($s, 8, 8); 3739 } 3740 close STAMP; 3741} 3742$oldstamp1 ||= "00000000"; 3743 3744# clear the wip 3745if (opendir(WIP, "$basedir/drpmsync/wip")) { 3746 for (readdir(WIP)) { 3747 next if $_ eq '.' || $_ eq '..'; 3748 unlink("$basedir/drpmsync/wip/$_") || die("unlink $basedir/drpmsync/wip/$_: $!\n"); 3749 } 3750 closedir(WIP); 3751} 3752 3753readcache("$basedir/drpmsync/cache"); 3754print "getting state of local tree...\n"; 3755findfiles($basedir, '', 1); 3756print("cache: $cachehits hits, $cachemisses misses\n"); 3757writecache("$basedir/drpmsync/cache"); 3758 3759if (!@config_source) { 3760 # just a cache update... 3761 unlink("$basedir/drpmsync/lock"); 3762 close(LOCK); 3763 exit(0); 3764} 3765 3766mkdir_p("$basedir/drpmsync/wip"); 3767 3768$SIG{'ALRM'} = sub {die("network timeout\n");}; 3769 3770my @syncfiles; 3771find_source(\@syncfiles, $cmdline_norecurse || $cmdline_use_filelist, 1, @config_source); 3772filelist_from_file(\@syncfiles, $cmdline_use_filelist) if defined $cmdline_use_filelist; 3773 3774$config_recvlog = "$basedir/drpmsync/$config_recvlog" if $config_recvlog && $config_recvlog !~ /^\//; 3775if ($config_recvlog) { 3776 open(RECVLOG, '>>', $config_recvlog) || die("$config_recvlog: $!\n"); 3777 select(RECVLOG); 3778 $| = 1; 3779 select(STDOUT); 3780 recvlog("started update from $syncurl"); 3781 $SIG{'__DIE__'} = sub { 3782 my $err = $_[0]; 3783 $err =~ s/\n$//s; 3784 recvlog($err); 3785 die("$err\n"); 3786 }; 3787} 3788 3789if ($oldstamp1 ne '00000000' && $oldstamp1 gt $newstamp1) { 3790 if ($newstamp1 eq '00000000') { 3791 die("remote tree is incomplete\n"); 3792 } 3793 die("remote tree is older than local tree (last completion): ".toiso(hex($newstamp1))." < ".toiso(hex($oldstamp1))."\n"); 3794} 3795if ($oldstamp2 && $oldstamp2 gt $newstamp2) { 3796 die("remote tree is older than local tree (last start): ".toiso(hex($newstamp2))." < ".toiso(hex($oldstamp2))."\n"); 3797} 3798open(STAMP, '>', "$basedir/drpmsync/timestamp.new") || die("$basedir/drpmsync/timestamp.new: $!\n"); 3799print STAMP "$oldstamp1$newstamp2\n"; 3800close STAMP; 3801rename("$basedir/drpmsync/timestamp.new", "$basedir/drpmsync/timestamp"); 3802 3803# change all directories to at least user rwx 3804for (@syncfiles) { 3805 next if $_->[2] !~ /^0/; 3806 next if (hex(substr($_->[2], 0, 4)) & 0700) == 0700; 3807 $_->[2] = sprintf("0%03x", hex(substr($_->[2], 0, 4)) | 0700).substr($_->[2], 4); 3808} 3809 3810printf "local: ".@files." entries\n"; 3811printf "remote: ".@syncfiles." entries\n"; 3812 3813rsync_adapt_filelist(\@syncfiles) if $syncproto eq 'rsync'; 3814 3815%files = map {$_->[0] => $_} @files; 3816%syncfiles = map {$_->[0] => $_} @syncfiles; 3817 3818# 1) create all new directories 3819# 2) delete all dirs that are now files 3820# 3) get all rpms and update/delete the associated files 3821# 4) update all other files 3822# 5) delete all files/rpms/directories 3823# 6) set mode/time of directories 3824 3825# part 1 3826for my $dir (grep {@$_ == 3} @syncfiles) { 3827 my $d = $files{$dir->[0]}; 3828 if ($d) { 3829 next if $d->[2] =~ /^0/; 3830 recvlog_print("- $d->[0]"); 3831 unlink("$basedir/$d->[0]") || die("unlink $basedir/$d->[0]: $!\n"); 3832 } 3833 recvlog_print("+ $dir->[0]"); 3834 mkdir("$basedir/$dir->[0]", 0755) || die("mkdir $basedir/$dir->[0]: $!\n"); 3835 fixmodetime("$basedir/$dir->[0]", $dir->[2]); 3836 my @s = lstat("$basedir/$dir->[0]"); 3837 die("$basedir/$dir->[0]: $!\n") unless @s; 3838 $files{$dir->[0]} = [ $dir->[0], "$s[9]/$s[7]/$s[1]", sprintf("0%03x%08x", ($s[2] & 07777), $s[9]) ]; 3839 dirchanged($dir->[0]); 3840} 3841 3842# part 2 3843@files = sort {$a->[0] cmp $b->[0]} values %files; 3844for my $dir (grep {@$_ == 3} @files) { 3845 my $sd = $syncfiles{$dir->[0]}; 3846 next if !$sd || $sd->[2] =~ /^0/; 3847 next unless $files{$dir->[0]}; 3848 my @subf = grep {$_->[0] =~ /^\Q$dir->[0]\E\//} @files; 3849 unshift @subf, $dir; 3850 @subf = reverse @subf; 3851 for my $subf (@subf) { 3852 recvlog_print("- $subf->[0]"); 3853 if ($subf->[2] =~ /^0/) { 3854 rmdir("$basedir/$subf->[0]") || die("rmdir $basedir/$subf->[0]: $!\n"); 3855 } else { 3856 unlink("$basedir/$subf->[0]") || die("unlink $basedir/$subf->[0]: $!\n"); 3857 } 3858 repo_del("$basedir/$subf->[0]", $subf) if $config_repo; 3859 delete $files{$subf->[0]}; 3860 } 3861 dirchanged($dir->[0]); 3862 @files = sort {$a->[0] cmp $b->[0]} values %files; 3863} 3864 3865# part 3 3866my @syncrpms = grep {@$_ > 5} @syncfiles; 3867# sort by rpm built date 3868@syncrpms = sort {$a->[4] cmp $b->[4]} @syncrpms; 3869for my $rpm (@syncrpms) { 3870 update($basedir, $rpm); 3871 # update meta file(s) 3872 my $rpmname = $rpm->[0]; 3873 $rpmname =~ s/\.[sr]pm$//; 3874 for my $afn ("$rpmname.changes", "$rpmname-MD5SUMS.meta", "$rpmname-MD5SUMS.srcdir") { 3875 my $sd = $syncfiles{$afn}; 3876 my $d = $files{$afn}; 3877 next if !$d && !$sd; 3878 if ($d && !$sd) { 3879 next if $d->[2] =~ /^0/; 3880 recvlog_print("- $d->[0]"); 3881 unlink("$basedir/$d->[0]") || die("unlink $basedir/$d->[0]: $!\n"); 3882 dirchanged($d->[0]); 3883 delete $files{$d->[0]}; 3884 } else { 3885 update($basedir, $sd); 3886 } 3887 } 3888} 3889 3890# part 4 3891for my $file (grep {@$_ == 4} @syncfiles) { 3892 update($basedir, $file); 3893} 3894 3895checkjob() if $runningjob; 3896 3897send_fin(); 3898 3899# part 5 3900@files = sort {$a->[0] cmp $b->[0]} values %files; 3901for my $file (grep {!$syncfiles{$_->[0]}} reverse @files) { 3902 recvlog_print("- $file->[0]"); 3903 if ($file->[2] =~ /^0/) { 3904 rmdir("$basedir/$file->[0]") || die("rmdir $basedir/$file->[0]: $!\n"); 3905 } else { 3906 unlink("$basedir/$file->[0]") || die("unlink $basedir/$file->[0]: $!\n"); 3907 repo_del("$basedir/$file->[0]", $file) if $config_repo; 3908 } 3909 dirchanged($file->[0]); 3910 delete $files{$file->[0]}; 3911} 3912 3913# part 6 3914for my $dir (grep {@$_ == 3} @syncfiles) { 3915 my $d = $files{$dir->[0]}; 3916 next if !$d || $d->[2] eq $dir->[2]; 3917 fixmodetime("$basedir/$dir->[0]", $dir->[2]); 3918} 3919 3920@files = sort {$a->[0] cmp $b->[0]} values %files; 3921writecache("$basedir/drpmsync/cache"); 3922 3923if (!$had_gone) { 3924 open(STAMP, '>', "$basedir/drpmsync/timestamp.new") || die("$basedir/drpmsync/timestamp.new: $!\n"); 3925 print STAMP "$newstamp1$newstamp2\n"; 3926 close STAMP; 3927 rename("$basedir/drpmsync/timestamp.new", "$basedir/drpmsync/timestamp"); 3928} 3929 3930if (defined($config_delta_max_age)) { 3931 print "removing outdated deltas...\n"; 3932 my $nold = 0; 3933 my $cut = time() - 24*60*60*$config_delta_max_age; 3934 if (opendir(PACKS, "$basedir/drpmsync/deltas")) { 3935 my @packs = readdir(PACKS); 3936 closedir(PACKS); 3937 for my $pack (@packs) { 3938 next if $pack eq '.' || $pack eq '..'; 3939 next unless opendir(DELTAS, "$basedir/drpmsync/deltas/$pack"); 3940 my @deltas = readdir(DELTAS); 3941 closedir(DELTAS); 3942 for my $delta (@deltas) { 3943 next if $delta eq '.' || $delta eq '..'; 3944 my @s = stat "$basedir/drpmsync/deltas/$pack/$delta"; 3945 next unless @s; 3946 next if $s[9] >= $cut; 3947 unlink("$basedir/drpmsync/deltas/$pack/$delta") || die("unlink $basedir/drpmsync/deltas/$pack/$delta: $!\n"); 3948 $nold++; 3949 } 3950 } 3951 } 3952 recvlog_print("removed $nold deltarpms") if $nold; 3953} 3954my $net_kbsec = 0; 3955$net_kbsec = int($net_recv_bytes / 1024 / $net_spent_time) if $net_spent_time; 3956recvlog("update finished $txbytes/$rvbytes/$sabytes $net_kbsec"); 3957close(RECVLOG) if $config_recvlog; 3958unlink("$basedir/drpmsync/lock"); 3959close(LOCK); 3960if ($sabytes == 0) { 3961 printf "update finished, sent %.1f K, received %.1f M\n", $txbytes / 1000, $rvbytes / 1000000; 3962} elsif ($sabytes < 0) { 3963 printf "update finished, sent %.1f K, received %.1f M, deltarpm excess %.1f M\n", $txbytes / 1000, $rvbytes / 1000000, (-$sabytes) /1000000; 3964} else { 3965 printf "update finished, sent %.1f K, received %.1f M, deltarpm savings %.1f M\n", $txbytes / 1000, $rvbytes / 1000000, $sabytes /1000000; 3966} 3967printf "network throughput %d kbyte/sec\n", $net_kbsec if $net_spent_time; 3968exit 24 if $had_gone; 3969