debian-cd-clone/tools/publish_cds

#! /usr/bin/perl -w
    eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
        if 0; #$running_under_some_shell

# $Id$

# Copyright (c) 2002 Philip Hands <phil@hands.com>
# See the README file for the license

# This script creates the md5sums files, using the precalculated md5sums
# from the main archive
#
# First arg = the version directory name to target
#
# subsequent optional arguments are the architectures to publish
# If omited, the script will use all the directories in the $OUT
# directory as the architectures to publish.
#
# For example:
#     ./tools/publish_cds 3.0-pre2 i386 src m68k
#

use strict;
use MIME::Base64;
use File::Copy;
use Compress::Zlib ;

my $cd_version = shift @ARGV || die "Usage: $0 <cd_version> [<arch> ...]\n" ;
my %conf;
my %jigdosums;

sub jigsum_to_md5sum ($) {
  my $str = shift;
  
  $str =~ tr%-_%+/% ;                     # convert to  normal base64
  $str =~ tr|A-Za-z0-9+=/||cd;            # remove non-base64 chars
  $str =~ tr|A-Za-z0-9+/| -_|;            # convert to uuencoded format
  
  return unpack('H32', join'',
		map( unpack("u", chr(32 + length($_)*3/4). $_),
		     $str =~ /(.{1,60})/gs));
}

sub mkdirs ($);

sub mkdirs ($) {
  my $path = shift;

  return 1 if (-d $path) ;

  if ($path =~ m|^(.*)/[^/]*$|) {
    mkdirs($1);
  }

  mkdir($path);
}

sub md5sum_file($) {
  open(FILE, $_) or die "Can't open '$_': $!";
  binmode(FILE);
  my ($retval) = Digest::MD5->new->addfile(*FILE)->hexdigest ;
  close(FILE) ;
  return($retval);
}

# Pick up settings from CONF.sh

open(SHELL, "sh -x CONF.sh 2>&1|") || die;
while(<SHELL>) {
  chomp;
  next unless (/^[+] export (.*)$/);
  next unless ($1 =~ /^'([^=]+)=(.*)'$/ || $1 =~ /^([^=]+)=(.*)$/) ;
  $conf{$1} = $2;
}
close(SHELL) ;

my $from_dir = $conf{'OUT'} ;
my $mirror_dir = $conf{'MIRROR'} ;
my $nonus_dir = $conf{'NONUS'} ;
my $tdir = $conf{'TDIR'} ;
my $publish_url = $conf{'PUBLISH_URL'} ;
my $publish_path = $conf{'PUBLISH_PATH'} ;

my $to_dir = $publish_path . "/" . $cd_version . "/" ;
my $fallback_url = $publish_url . "/$cd_version/snapshot/" ; 

my @archs ;
if ($#ARGV >= 0) {
  foreach (@ARGV) {
    push @archs, $from_dir . "/" . $_ ;
  }
} else {
  @archs = <$from_dir/*> ;
}

for my $arch (@archs) {
  my $bad_images ;

  my $to_arch = $arch ;
  $to_arch =~ s|^$from_dir|$to_dir/jigdo| ;
  $to_arch =~ s%/src$%/source% ;
  mkdirs($to_arch) || die "failed to create $to_arch" ;

  open(MD5OUT, ">$to_arch/MD5SUMS");

  for my $jigdo (<$arch/*.jigdo>) {
    my ($http, $filename, $size, $md5) ;

    $jigdo =~ m|/([^-/]*)-([^-/]*)-([^-/]*)\.jigdo$| ;
    my ($distname) = $1 ;
    my ($archname) = $2 ;
    my ($diskname) = $3 ;

    # find out the image name
    open (JIGDO, $jigdo) || die;
    printf "Opening %s\n", $jigdo ;

    my ($newjigdo) = $jigdo ;
    $newjigdo =~ s|^.*/([^/]*)$|$to_arch/$1| ;
    my $jigdo_gz = gzopen($newjigdo, "wb") ||
      die "ERROR: failed to open $newjigdo ($!)";

    my $section = "" ;
    while(<JIGDO>) {
      chomp;
      if (/^\[(.*)\]$/) {
	die "ERROR: don't know how to handle multi-image jigdo files"
	  if ($section eq "Image" && $1 eq "Image") ;
	$section = $1;
        $jigdo_gz->gzwrite($_ . "\n") ;
	next ;
      }
      if ($section eq "Image") {
	if (/^Filename=(.*)$/) { $filename = $1 ; }
	if (/^Template=(.*)$/) {
	  $_ = "Template=$publish_url/$cd_version/jigdo/$archname/$distname-$archname-$diskname.template" ;
	}
      }
      elsif ($section eq "Parts") {
	if (/^([^=]*)=(.*)$/) {
	  my $jigsum = $1 ;
	  my $file = $2 ;
	  if (defined($jigdosums{$file})) {
	    die "sums don't match for $file" if ($jigdosums{$file} ne $jigsum);
	  } else {
	    $jigdosums{$file} = $jigsum ;
	  }

	  # and now we make the hardlink snapshot,
	  # and check that all the md5's match

	  my $frompath = $file ;
	  my $tsubdir = "$distname-$archname/CD$diskname" ;
	  $frompath =~ s|^Debian:|$tdir/$tsubdir/| ;
	  $frompath =~ s|^Non-US:|$tdir/$tsubdir/| ;

	  if (!-f $frompath) {
	    print STDERR "WARNING: $frompath is not a file\n" ;
	    # if it's missing, let's grab it from the mirror
	    $frompath = $file ;
	    $frompath =~ s|^Debian:|$mirror_dir/| ;
	    $frompath =~ s|^Non-US:|$nonus_dir/| ;
          }

	  my $topath = $file ;
	  $topath =~ s|^Debian:|$to_dir/snapshot/| ;
	  $topath =~ s|^Non-US:|$to_dir/snapshot/| ;

	  $topath =~ m|^(.*)/[^/]*$| ;
	  mkdirs($1) ;
	  if (-f $frompath) {
	    if (!-f $topath) {
	      link ($frompath, $topath) || 
	        die "ERROR: linking $frompath to $topath";
	    } else {
	      use File::Compare;
	      my ($f_dev,$f_ino) = lstat($frompath) ;
	      my ($t_dev,$t_ino) = lstat($topath) ;
	      if ((($f_dev != $t_dev) || ($f_ino != $t_ino)) &&
		  compare($frompath,$topath) != 0) {
		die "ERROR: $frompath != $topath" ;
	      }
	    }
	  } else {
	    print STDERR "ERROR: $frompath is not a file\n" ;
	  }

        }
      }
      $jigdo_gz->gzwrite($_ . "\n") ;
    }
    $jigdo_gz->gzwrite(sprintf "\n[Servers]\nDebian=%s\nNon-US=%s\n",
      			       $fallback_url, $fallback_url); 

    $jigdo_gz->gzclose() ;
    close(JIGDO);

    # get the checksum & size from the template
    my $template = $jigdo ;
    $template =~ s/.jigdo$/.template/ ;
    open (TPL, "jigdo-file ls --template $template|") || die;
    while (<TPL>) {
      chomp;
      next unless (/^image-info\s+(\S+)\s+(\S*)\s+(\S+)$/) ;
      $size = $1 ;
      $md5 = jigsum_to_md5sum($2);
    }
    if (!defined($md5)) {
      $bad_images++ ;
      print STDERR "ERROR: md5 not available from $template\n";
      next;
    }
    print STDERR "WARNING: image too small ($size in $template)\n"
      if ($size < 10000000) ;
    print STDERR "WARNING: image too big ($size in $template)\n"
      if ($size > 681574400) ;
    printf MD5OUT "%032s  %s\n", $md5, $filename;
    close(TPL) ;

    copy($template, $to_arch) ||
      die "ERROR copying $template to $to_arch ($!)" ;
  }
  close(MD5OUT);
  unlink ("$to_arch/MD5SUMS") if ($bad_images) ;

}