#!/usr/bin/perl -w

#todo:
# * download new setup.exe automatically (and warn about potential setup.ini
#   format changes)
# * download mirror list, rather than hardwiring the URL.  May mean checking
#   setup.ini dates, too.  http://www.cygwin.com/mirrors.lst
# * actually install stuff, rather than just downloading it, and cope even when
#   trying to update a running cygwin
# * go back to downloading setup.bz2 rather than setup.ini
# * don't delete (or mv) old versions if new version didn't download properly
# * make setup.ini splitting more robust if the file format changes.
#   In particular, spot if something other than
#   /^(install|source|version):/ is found after a [section] heading,
#   and report that something may be wrong.

use strict;
use Getopt::Long;
use Digest::MD5;
use File::Find;

if((my $dir=$0)=~s![/\\][^/\\]*$!!){chdir $dir;} #change to own directory

#different sections of setup.ini will be downloaded into these dirs:
my @sections=qw(install.curr install.prev install.test
                source.curr  source.prev  source.test);

#built-in defaults
my %dld;
foreach (@sections){$dld{$_}=0;}
my $url="ftp://ftp.plig.net/pub/cygwin";
my $logfile; #none by default

newcfg(); #create update.cfg if it doesn't already exist
readcfg(); #read settings from update.cfg

#other variables set from command-line
my $existing=0; #use existing setup.ini
my $help=0;
my $version=0;
my $debug=0;

parse(); #parse commandline switches

if(defined $logfile&&$logfile ne ""){
    open STDOUT,">>$logfile";
}

#add scheme to url if necessary
unless($url=~m!^(?:ftp|https?)://!){
    if($url=~/^ftp/){
        $url="ftp://$url";
    }else{
        $url="http://$url";
    }
}

if($debug){
    print "url=$url\n";
    print "dld={\n";
    foreach (sort keys %dld){
        print "  $_ => $dld{$_}\n";
    }
    print "}\n";
    print "existing=$existing\n";
    exit;
}

if($help){
    die "Help not yet implemented\n";
}
if($version){
    die "Version 0.00\n";
}

#make sure we're downloading something
my $ok=0;
foreach (@sections){$ok=1 if $dld{$_};}
$ok or die "Nothing to do.  Edit update.cfg, or use -a to download all.\n";

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

print scalar localtime,"\n";
$url=~s!/$!!; #remove trailing /

#wget("setup.bz2","setup.bz2");
#system "bunzip2 <setup.bz2 >setup.ini";

my $oldtime;
unless($existing){
    if(-f "setup.ini.previous"){
        unlink "setup.ini.previous";
    }
    if(-f "setup.ini"){
        system("/bin/cp","-a","setup.ini","setup.ini.previous");
        if(open SETUP,"<setup.ini.previous"){
            while(<SETUP>){
                if(/^setup-timestamp: ([0-9]+)/){
                    $oldtime=$1;
                    last;
                }
            }
            close SETUP;
        }
    }
    
    wget("setup.ini","setup.ini");
    #system("/bin/chmod","a+w","setup.ini"); #but why should I need to?
}

my $sect="";
$ok=0;
open SETUP,"<setup.ini" or die "Can't open setup.ini";
if(defined($oldtime)){
    while(<SETUP>){
        if(/^setup-timestamp: ([0-9]+)/){
            $ok=1;
            if($1<$oldtime){
                print "#  Older setup.ini downloaded; ignoring\n";
            }else{
                $ok=2;
            }
            last;
        }
    }
    if($ok!=2){
        if(!$ok){
            print "#  No timestamp in setup.ini; ignoring file\n";
        }
        close SETUP;
        unlink "setup.ini";
        rename("setup.ini.previous","setup.ini");
        open SETUP,"<setup.ini" or die "Can't open old setup.ini";
    }else{
        seek SETUP,0,0;
    }
}

my %setup; #lexical scoping for open

my @finddir=("release");
my @dir=();
my @search=();
foreach my $dir (@sections){
    push @dir,$dir;
    push @search,"$dir/release";
    push @finddir,"$dir/release";
    mkdir $dir;
    open $setup{$dir},">$dir/setup.ini"
        or die "Can't create $dir/setup.ini";
}
push @search,"release"; #find stuff in the previous version's release/ dir
push @search,"old"; #recover files lost if setup.ini was truncated last time

my($prefix,$ver,$blank,%sect,%filename,%sz,%md5,%data);

nextitem();

while(<SETUP>){
    if(/^\@/){
        process();
        $prefix=$_;
        $sect="curr";
    }elsif(/^\[(.*)\]\r?$/){
        $sect=$1;
        $sect{$sect}=$_;
    }elsif(/^version:/){
        $ver=$_;
    }elsif(my($type,$filename,$sz,$md5)=
           /^(install|source): ([^ ]+) (\d+) ([0-9A-Fa-f]{32})/){
        my $dir="$type.$sect";
        $data{$dir}=$ver.$_;
        $filename{$dir}=$filename;
        $sz{$dir}=$sz;
        $md5{$dir}=$md5;
    }elsif(!/^\r?$/){
        $prefix.=$_;
    }else{
        $blank=$_;
    }
}
process();

@finddir=grep {-d $_} @finddir;

my %seen;
if(@finddir){
    my @found=();
    find({wanted=>sub{
        return unless -f $_;
        #current dir changes while find() is running, so just push results here
        push @found,$File::Find::name;
    }},@finddir);
    foreach (@found){
        m!.*?release/(.*)!;
        next if $seen{$1};
        my $old="old/$1";
        my $rel=$_;
        makepathfor($old);
        print "rm $rel";
        rename $rel,$old;
        removepathfor($rel);
        print "\n";
    }
}

print "\n";

sub nextitem{
    $prefix="";
    foreach my $dir (@dir){
        undef $data{$dir};
    }
}

sub process{
    if($prefix ne ""){
        my $all=1;
        foreach my $dir (@dir){
            if(defined $data{$dir}){
                $all=0;
            }
        }
        foreach my $dir (@dir){
            my $fh=$setup{$dir};
            if($all||defined $data{$dir}){
                print $fh $prefix;
            }
            if(defined $data{$dir}){
                $dir=~/\.(.*)$/;
                if($1 ne "curr"){
                    print $fh $sect{$1};
                }
                print $fh $data{$dir};
                download($dir,$filename{$dir},$sz{$dir},$md5{$dir});
            }
            if($all||defined $data{$dir}){
                print $fh $blank;
            }
        }
    }
    nextitem();
}

sub makepathfor{
    my($f)=@_;
    return unless $f=~s!/[^/]+$!!;
    return if -d $f;
    mkdir $f;
    return if -d $f;
    makepathfor($f);
    mkdir $f;
}

sub removepathfor{
    my($f)=@_;
    return unless $f=~s!/[^/]+$!!;
    rmdir $f;
    return if -d $f;
    removepathfor($f);
}

sub download{
    my($dir,$filename,$sz,$md5)=@_;
    my $lfile=$filename;
    $lfile=~s!^[^/]*/(.*)!$1!;#local filename (without "release/" dir)
    my $lfull="$dir/release/$lfile";#local filename (with full relative path)
    $seen{$lfile}=1;
    if(!-f $lfull){
        foreach my $search (@search){
            if(-f "$search/$lfile"){
                makepathfor($lfull);
                rename "$search/$lfile","$lfull";
                removepathfor("$search/$lfile");
                if($lfull=~/^install/){
                    #only print for install, as source causes
                    #spurious output when same file appears as source
                    #to different (test/prev/curr) items
                    print "move $lfull\n";
                }
                last;
            }
        }
    }
    if(!-f $lfull || -s $lfull!=$sz){
        if($dld{$dir}){
            if(-f $lfull && -s $lfull>$sz){
                unlink $lfull;
            }
            print "wget $lfull\n";
            makepathfor($lfull);
            wget($lfull,$filename,"-c");

            if(!-f $lfull || -s $lfull != $sz){
                print "#  Wrong size: $lfull\n";
                unlink $lfull;
            }else{
                my $actualMd5=md5sum($lfull);
                if(lc $md5 ne lc $actualMd5){
                    print "#  Wrong sum: $lfull\n";
                    unlink $lfull;
                }
            }
        }
    }
}

sub wget{
    my($loc,$rem,@cont)=@_;
    return system("wget", @cont, "-O",$loc, "-C","off",
                  "--header","Cache-control: max-age=0",
                  "$url/$rem");
}

sub md5sum{
    my($name)=@_;
    if(open my $h,"<$name"){
        binmode $h;
        my $md5=Digest::MD5->new;
        eval{$md5->addfile($h)};
        close $h;
        return $md5->hexdigest if $@ eq "";
    }
    return "";
}


sub newcfg{ #create update.cfg if it doesn't already exist
    if(!-f "update.cfg" && open CFG,">update.cfg"){
        print CFG "#what to download:\n";
        foreach (@sections){print CFG "$_=0\n";}
        print CFG "\n";
        print CFG "#where to get it from:\n";
        print CFG "url=$url\n";
        print CFG "\n";
        print CFG "#log to given file instead of stdout\n";
        if(defined $logfile){
            print CFG "logfile=$logfile\n";
        }else{
            print CFG "#logfile=\n";
        }
        close CFG;
    }
}

sub readcfg{ #read settings from update.cfg
    if(open CFG,"<update.cfg"){
        while(<CFG>){
            chomp;s/\r$//;
            s/\#.*//;
            s/^\s+//;
            s/\s+$//;
            next if $_ eq "";
            my($var,$val);
            unless(($var,$val)=/^([^=]+?)\s*=\s*(.*)$/){
                die "Invalid syntax in update.cfg: $_\n";
            }
            $var=lc $var;
            if($var eq "url"){
                $url=$val;
            }elsif($var eq "logfile"){
                $logfile=$val;
            }elsif(defined $dld{$var}){
                $val=lc $val;
                $val=1 if $val eq "yes";
                $val=1 if $val eq "y";
                $val=1 if $val eq "true";
                $val=1 if $val eq "t";
                $val=1 if $val eq "on";
                $val=0 unless $val eq 1;
                $dld{$var}=$val;
            }else{
                die "Unknown variable: $var\n";
            }
        }
        close CFG;
    }
}

sub parse{ #parse commandline switches
    sub ignore{}
    Getopt::Long::Configure("bundling");
    GetOptions('u|url=s'                        =>\$url,
               'c|current:1'                    =>\$dld{"install.curr"},
               'p|previous:1'                   =>\$dld{"install.prev"},
               't|test:1'                       =>\$dld{"install.test"},
               'C|current-source:1'             =>\$dld{"source.curr"},
               'P|previous-source|prev-source:1'=>\$dld{"source.prev"},
               'T|test-source:1'                =>\$dld{"source.test"},
               'a|all:1'                        =>sub{
                   foreach (@sections){$dld{$_}=$_[1];}
               },
               'e|existing|use-existing!'       =>\$existing,
               'l|logfile=s'                    =>\$logfile,
               'V|version'                      =>\$version,
               'h|help|?'                       =>\$help,
               'g|debug:+'                      =>\$debug,
        #setup.exe uses the following (which are ignored for now):
                 # Disable known or suspected buggy anti virus
                 # software packages during execution.
               'A|disable-buggy-antivirus'=>\&ignore,
                 # Disable creation of desktop and start menu
                 # shortcuts
               'n|no-shortcuts'           =>\&ignore,
                 # Disable creation of start menu shortcut
               'N|no-startmenu'           =>\&ignore,
                 # Disable creation of desktop shortcut
               'd|no-desktop'             =>\&ignore,
                 # Suppress MD5 checksum verification
               '5|no-md5'                 =>\&ignore,
                 # Disable replacing in-use files on next reboot.
               'r|no-replaceonreboot'     =>\&ignore,
                 # Unattended setup mode
               'q|quiet-mode'             =>\&ignore,
                 # Unattended setup mode
               'D|download'               =>\&ignore,
                 # Install from local directory
               'L|local-install'          =>\&ignore,
                 # Override registry name to allow parallel installs
                 # for testing purposes
               'override-registry-name=s' =>\&ignore)
        or exit;
}