#!/usr/bin/perl -CA
# deb-upload v1.0.2  (c) 25.3.2019 by Andreas Ley  (u) 10.1.2020
# Upload debian package to SCC repository

# You need to have ssh access to this account
my $user = 'scc-ftp-0001';
#my $host = 'net-archive.scc.kit.edu';
my $host = 'net-web11.scc.kit.edu';
my $directory = 'incoming';

use strict;
#no strict 'vars';
use warnings;
no warnings 'uninitialized';
use sigtrap;
use diagnostics;

# The script itself may use utf-8 encoded identifiers and literals
use utf8;
# Latin-1 codepoints are considered characters
use feature 'unicode_strings';
#use locale;
# Enable UTF-8 encoding for all files (but not already open handles)
use open ':encoding(utf8)';

use Getopt::Long;
use File::Basename;
#use File::Spec::Functions;

my $ssh = '/usr/bin/ssh';
my $scp = '/usr/bin/scp';
my $reprepro = '/usr/bin/reprepro --confdir ./reprepro/conf';

use Term::Cap;
use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Terse = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Deepcopy = 1;
#warn Data::Dumper->Dump([\%hash],['*']) if ($debug{'file'}>0);
#warn Data::Dumper->new([\%hash],['*'])->Indent(0)->Dump if ($debug{'file'}>0);

my (@releases,$component,$path);

sub usage
{
	my $image = $0;
	$image =~ s!.*/!!;
	print  STDERR  "Usage: $image [options]\n";
	print  STDERR  "Usage: $image -d [options] [package-name]\n";
	print  STDERR  "-v, --verbose	Verbose mode\n";
	print  STDERR  "-r, --release	Debian release (default ".join(', ',@releases).") (may be used more than once)\n";
	print  STDERR  "-c, --component	Debian component (default $component)\n";
	print  STDERR  "-d, --delete	Don't upload but delete package (all versions) from repository\n";
	exit(1);
}

my %opt;
@_ = @ARGV;
$Getopt::Long::ignorecase = 0;
GetOptions (\%opt,'debug|D:s','help|h','trace|x','verbose|v+','dry-run|n',
	'release|r=s@','component|c=s',
	'skip-upload|s',
	'delete|d');
exec($^X,'-d:Trace',$0,@_) if (defined($opt{'trace'}) && !defined($Devel::Trace::TRACE));

# FIXME: Use `lsb_release -cs`
@releases = defined($opt{'release'}) ? @{$opt{'release'}} : defined($ENV{'DEBIAN_RELEASE'}) ? ($ENV{'DEBIAN_RELEASE'}) : (&debian_release());
$component = $opt{'component'} // $ENV{'DEBIAN_COMPONENT'} // 'main';

&usage() if (defined($opt{'help'}) || @ARGV && !defined($opt{'delete'}));

if (defined($opt{'verbose'}) || defined($opt{'debug'})) {
	$|=1;
	select((select(STDERR),$|=1)[0]);
}

my (%debug,$on,$off);

sub debug
{
	my $file = shift;
	my $line = shift;
	my $prefix = defined($debug{'path'})?$file:defined($debug{'file'})?basename($file):'';
	if (defined($debug{'line'})) {
		$prefix .= ':' if (length($prefix));
		$prefix .= $line;
	}
	$prefix .= '  ' if (length($prefix));
	warn $prefix.(scalar(@_)>1 ? join(', ',map("\"$_\"",@_))."\n" : "@_\n");
}
$debug{undef} = \&debug;

if (defined($opt{'debug'})) {
	for (split(',',$opt{'debug'})) {
		if (/=/) {
			$debug{$`} = $';
		}
		else {
			$debug{$_} = 1;
		}
	}
	&debug(__FILE__,__LINE__,'%debug = '.Data::Dumper->Dump([\%debug],['*debug'])) if ($debug{'debug'}>0);
	my $term = Tgetent Term::Cap { 'OSPEED'=>9600 };
	$on = $term->Tputs('md');
	$off = $term->Tputs('me');
}

# Enable UTF-8 encoding for already open handles
# ":utf8" would enable perl native coding which happens to be UTF-8 only on ASCII platforms
binmode(STDIN,':encoding(utf8)');
binmode(STDOUT,':encoding(utf8)');
binmode(STDERR,':encoding(utf8)') unless (defined($Devel::Trace::TRACE));

my $remote = $user.'@'.$host;

# FIXME: get parameters from debian/control
my $dir = basename($ENV{'PWD'});
if ($dir =~ /-(\d.*)$/) {
	$path = '../'.$`.'_'.$1;
}
else {
	$path = '../'.$dir;
}

my $package_version = basename($path);
my $package = $package_version =~ s/_.*//r;

for my $release (@releases) {
	die "Invalid release: $release\n" unless ($release =~ /^\w+$/a);
}

die "Invalid component: $component\n" unless ($component =~ /^(?:main|contrib|non-free)$/a);

my $source;
my @packages = @ARGV;
unless (@packages) {
	open(CONTROL,'<','debian/control') or die "Can't read debian/control: $!\n";
	while (<CONTROL>) {
		chomp;
		$source = $' if (/^Source:\s*/);
		push(@packages,$') if (/^Package:\s*/);
	}
	close(CONTROL);
	# FIXME: read debian/changelog for version numbers
}

for my $package (@packages) {
	if (defined($opt{'delete'})) {
		for my $release (@releases) {
			&shell($ssh,$remote,"$reprepro remove $release $package");
		}
	}
	else {
		for my $deb (glob('../'.$package.'_*.deb')) {
			&shell($scp,'-p',$deb,"$remote:$directory/");
			for my $release (@releases) {
				&shell($ssh,$remote,"$reprepro -C $component includedeb $release $directory/".basename($deb));
			}
		}
	}
}
close(CONTROL);

if (defined($source)) {
	&shell($scp,'-p',$path.'.dsc',glob($path.'.tar.*'),"$remote:$directory/") unless (defined($opt{'skip-upload'}));
	for my $release (@releases) {
		&shell($ssh,"$user\@$host","$reprepro -C $component includedsc $release $directory/$package_version.dsc");
	}
}

sub shell
{
	&debug(__FILE__,__LINE__,'+ &shell('.join(',',map("'$_'",@_)).')') if ($debug{'call'}>1 || $debug{'shell'}>0);
	my (@cmd) = @_;

	print join(' ','+',@cmd)."\n" if (defined($opt{'verbose'}) || defined($opt{'dry-run'}));
	if (!defined($opt{'dry-run'})) {
		system(@cmd) and die "Can't run ".join(' ',@cmd).": $!\n";
	}
}

sub debian_release
{
	&debug(__FILE__,__LINE__,'+ &debian_release('.join(',',map("'$_'",@_)).')') if ($debug{'call'}>1 || $debug{'debian_release'}>0);

	my $release;
	if (open(VERSION,'<','/etc/debian_version')) {
		my $line = <VERSION>;
		close(VERSION);
		if ($line =~ /^7\.|wheezy/) {
			$release = 'wheezy';
		}
		elsif ($line =~ /^8\.|jessie/) {
			$release = 'jessie';
		}
		elsif ($line =~ /^9\.|stretch/) {
			$release = 'stretch';
		}
		elsif ($line =~ /^10\.|buster/) {
			$release = 'buster';
		}
		elsif ($line =~ /^11\.|bullseye/) {
			$release = 'bullseye';
		}
		elsif ($line =~ /^12\.|bookworm/) {
			$release = 'bookworm';
		}
		elsif ($line =~ /^13\.|trixie/) {
			$release = 'trixie';
		}
		elsif ($line =~ /^14\.|forky/) {
			$release = 'forky';
		}
		elsif ($line =~ /^15\.|duke/) {
			$release = 'duke';
		}
		elsif ($line =~ /sid|unstable/) {
			$release = 'sid';
		}
		else {
			die "Fix me, I'm outdated!\n";
		}
	}

	&debug(__FILE__,__LINE__,'+ &debian_release = '.$release) if ($debug{'return'}>1 || $debug{'debian_release'}>1);
	return($release);
}
