package SUSE::MyBS;

use strict;

use warnings;

use Carp;

use LWP::UserAgent;

use URI;

use XML::Parser;

use XML::Writer;

use HTTP::Request;

use File::Temp qw(tempfile);

use Config::IniFiles;

use Digest::MD5;

use SUSE::MyBS::Buildresults;

sub new {

	my ($class, $api_url) = @_;

	my $self = { };

	$api_url ||= "https://api.opensuse.org";

	$api_url =~ s:/*$::;

	if ($api_url !~ m@^https?://@) {

		$api_url = "https://$api_url";

	}

	$self->{url} = URI->new($api_url);

	my $cfgfile;

	foreach ("$ENV{HOME}/.oscrc", "$ENV{HOME}/.config/osc/oscrc") {

		if (-f) {

			$cfgfile = $_;

			last;

		}

	}

	defined $cfgfile or die "oscrc not found";

	# replace name: value with name= value that Config::IniFiles can parse

	open(my $fh, '<', $cfgfile) or die "$cfgfile: $!\n";

	my $data = "";

	my $changed = 0;

	while (<$fh>) {

		if (s/^([^[:=]+):/$1=/) {

			$changed = 1;

		}

		$data .= $_;

	}

	close($fh);

	my $config;

	if ($changed) {

		(my $fh, $cfgfile) = tempfile();

		print $fh $data;

		close($fh);

	}

	my %config;

	tie %config, 'Config::IniFiles', (-file => $cfgfile);

	if ($changed) {

		unlink($cfgfile);

	}

	if (!keys(%config)) {

		die join("\n", @Config::IniFiles::errors), "\n";

	}

	my %cred;

	for my $kw (qw(user pass passx keyring credentials_mgr_class)) {

		for my $section ($api_url, "$api_url/", $self->{url}->host) {

			if (exists($config{$section}) &&

					exists($config{$section}{$kw})) {

				$cred{$kw} = $config{$section}{$kw};

				last;

			}

		}

	}

	if (exists($cred{credentials_mgr_class})) {

		if ($cred{credentials_mgr_class} eq "osc.credentials.ObfuscatedConfigFileCredentialsManager") {

			$cred{passx}=$cred{pass};

	}}

	if (exists($cred{passx})) {

		# Not available on SLES10, hence the 'require'

		require MIME::Base64;

		require IO::Uncompress::Bunzip2;

		my $bz2 = MIME::Base64::decode_base64($cred{passx});

		$cred{pass} = "";

		IO::Uncompress::Bunzip2::bunzip2(\$bz2 => \$cred{pass})

			or die "Decoding password for $api_url failed: $IO::Uncompress::Bunzip2::Bunzip2Error\n";

	}

	if (!exists($cred{pass}) && exists($cred{keyring})) {

		my $api = $api_url;

		$api =~ s/^https?:\/\///;

		open(my $secret, "secret-tool lookup service $api username $cred{user} |")

		    or die "Please install the \"secret-tool\" package to use a keyring\n";

		$cred{pass} = <$secret>;

		close($secret);

		die "Failed to obtain secret from secret-tool\n"

		    if !$cred{pass};

		chomp($cred{pass});

	}

	if (!exists($cred{user}) || !exists($cred{pass})) {

			die "Error: Username or password for $api_url not set in ~/.oscrc\n" .

			"Error: Run `osc -A $api_url ls' once\n";

	}

	$self->{ua} = LWP::UserAgent->new;

	my $realm = "Use your developer account";

	$realm = "Use your SUSE developer account" if $api_url =~ /opensuse/;

	$self->{ua}->credentials($self->{url}->host_port, $realm,

		$cred{user}, $cred{pass});

	if ($self->{ua}->can('ssl_opts')) {

		$self->{ua}->ssl_opts(verify_hostname => 1);

	}

	bless($self, $class);

	if ($self->{url}->scheme eq "https" &&

				$self->{url}->host eq "api.suse.de" &&

				$self->{ua}->can('ssl_opts')) {

		eval {

			$self->get("/about");

		};

		if ($@) {

			# Use the canned certificate as a backup

			# XXX: Check that we really got an unknown cert error

			(my $pkg = __PACKAGE__) =~ s@::@/@g;

			$pkg .= ".pm";

			(my $cert = $INC{$pkg}) =~ s@[^/]*$@@;

			$cert .= "SUSE_Trust_Root.pem";

			$self->{ua}->ssl_opts(SSL_ca_file => $cert);

		}

	}

	return $self;

}

sub api {

	my ($self, $method, $path, $data) = @_;

	my $url = $self->{url} . $path;

	my $req = HTTP::Request->new($method => $url);

	if ($data) {

		$req->add_content($data);

		$req->header("Content-type" => "application/octet-stream");

	}

	#$self->{ua}->prepare_request($req);

	#print STDERR "req: " . $req->as_string() . "\n";

	#$self->{ua}->add_handler(request_send => sub { my($req, $ua, $handler) = @_; print STDERR "req: " . $req->as_string() . "\n"; return; m_method => "GET"});

	my $res = $self->{ua}->request($req);

	if ($res->code != 200) {

		#print STDERR $res->as_string();

		die "$method $path: @{[$res->message()]} (HTTP @{[$res->code()]})\n";

	}

	return $res->content();

}

sub get {

	my $self = shift;

	$self->api('GET', @_);

}

sub post {

	my $self = shift;

	$self->api('POST', @_);

}

sub put {

	my $self = shift;

	$self->api('PUT', @_);

}

sub put_file {

	my ($self, $file, $path) = @_;

	open(my $fh, '<', $file) or die "$file: $!\n";

	local $/ = undef;

	my $data = <$fh>;

	close($fh);

	$self->put($path, $data);

}

sub delete {

	my $self = shift;

	$self->api('DELETE', @_);

}

sub exists {

	my ($self, $path) = @_;

	eval {

		$self->get($path);

	};

	return 0 if $@;

	return 1;

}

sub project_exists {

	my ($self, $project) = @_;

	return $self->exists("/source/$project/_meta");

}

sub package_exists {

	my ($self, $project, $package) = @_;

	return $self->exists("/source/$project/$package/_meta");

}

sub readdir {

	my ($self, $path) = @_;

	my $xml = $self->get($path);

	my $handle_start = sub  {

		my ($self, $element, %attr) = @_;

		return unless $element eq "entry" || $element eq "binary";

		my $name;

		if ($attr{name}) {

			$name = $attr{name};

			delete($attr{name});

		} elsif ($attr{filename}) {

			$name = $attr{filename};

			delete($attr{filename});

		}

		$self->{res}->{$name} = \%attr;

	};

	my $p = XML::Parser->new(Handlers => {Start => $handle_start});

	$p->{res} = {};

	$p->parse($xml);

	return $p->{res};

}

# Return list of architectures for given repository of given project

sub get_repo_archs {

	my ($self, $project, $repository) = @_;

	my $xml = $self->get("/source/$project/_meta");

	my $handle_start = sub  {

		my ($self, $element, %attr) = @_;

		return if $element ne "repository";

		if (defined($repository)) {

			return if $attr{name} ne $repository;

		}

		if ($attr{name} eq "standard" ||

		    $attr{name} eq "ports" && $project !~ /\bopenSUSE:Factory\b/ ||

		    $attr{name} =~ /^SUSE_.*_Update$/ && $project =~ /^SUSE:Maintenance:/) {

			$self->{has_match} = 1;

			$self->{repo_name} = $attr{name};

			$self->{res}{$attr{name}} ||= [];

		}

	};

	my $handle_char = sub {

		my ($self, $string) = @_;

		if ($self->{has_match}) {

			$string =~ s/\s//g;

			$self->{cur_string} .= $string;

		}

	};

	my $handle_end = sub {

		my ($self, $element) = @_;

		if ($element eq "repository") {

			$self->{has_match} = 0;

		}

		if ($element eq "arch" && $self->{has_match}) {

			push(@{$self->{res}{$self->{repo_name}}}, $self->{cur_string});

			$self->{cur_string} = "";

		}

	};

	my $p = XML::Parser->new(Handlers => {

			Start => $handle_start,

			Char => $handle_char,

			End => $handle_end});

	$p->{res} = {};

	$p->parse($xml);

	return %{$p->{res}};

}

sub create_project {

	my ($self, $project, $options) = @_;

	my %limit_archs;

	$options->{title} ||= $project,

	$options->{description} ||= "";

	if (!exists($options->{build})) {

		$options->{build} = 1;

	}

	if (!exists($options->{publish})) {

		$options->{publish} = 1;

	}

	$options->{limit_archs} ||= [];

	if (scalar(@{$options->{limit_archs}})) {

		$limit_archs{$_} = 1 for @{$options->{limit_archs}};

	} else {

		$options->{limit_archs} = undef;

	}

	my $meta;

	my $writer = XML::Writer->new(OUTPUT => \$meta);

	$writer->startTag("project", name => $project);

	$writer->dataElement("title", $options->{title});

	$writer->dataElement("description", $options->{description});

	$options->{maintainers} ||= [];

	for my $m (@{$options->{maintainers}}) {

		if ($self->exists("/group/$m")) {

			$writer->emptyTag("group", groupid => $m,

				role => "maintainer");

		} elsif ($self->exists("/person/$m")) {

			$writer->emptyTag("person", userid => $m,

				role => "maintainer");

		} else {

			warn("User id $m does not exist at $self->{url}\n");

		}

	}

	if (!exists($options->{repos})) {

		if (!exists($options->{base})) {

			croak "Either 'base' or 'repos' must be specified";

		}

		$options->{repository} ||= "";

		$options->{repos} = { $options->{repository} => $options->{base} };

	}

	my %seen_archs;

	my @qa_repos;

	for my $repo (sort(keys(%{$options->{repos}}))) {

		my $base = $options->{repos}{$repo};

		my %repo_archs;

		if ($repo eq "") {

			# get all "default" repositories of a given project

			%repo_archs = $self->get_repo_archs($base);

		} else {

			# get the "standard" repository of a given project

			%repo_archs = $self->get_repo_archs($base, "standard");

		}

		for my $r (sort(keys(%repo_archs))) {

			my $name = $repo ? $repo : $r;

			my @attrs = (name => $name);

			if (!$options->{rebuild}) {

				push(@attrs, rebuild => "local", block => "local");

			}

			my @archs;

			for my $arch (@{$repo_archs{$r}}) {

				if ($options->{limit_archs} &&

					!$limit_archs{$arch}) {

					next;

				}

				# only build each arch once

				if ($seen_archs{$arch}) {

					next;

				}

				$seen_archs{$arch} = 1;

				push(@archs, $arch);

			}

			if (!@archs) {

				# this repository is not needed

				next;

			}

			$writer->startTag("repository", @attrs);

			$writer->emptyTag("path", repository => $r,

				project => $base);

			for my $arch (@archs) {

				$writer->dataElement("arch", $arch);

			}

			$writer->endTag("repository");

			if (!exists($options->{qa})) {

				next;

			}

			# For each regular repository foo, there is a

			# repository named QA_foo, building against foo

			my $qa_name = ($name eq "standard") ? "QA"

					: "QA_$name";

			$writer->startTag("repository", name => $qa_name);

			$writer->emptyTag("path", repository => $name,

				project => $project);

			for my $arch (@archs) {

				$writer->dataElement("arch", $arch);

			}

			$writer->endTag("repository");

			push(@qa_repos, $qa_name);

		}

	}

	for my $attr (qw(build publish debuginfo)) {

		$writer->startTag($attr);

		$writer->emptyTag($options->{$attr} ? "enable" : "disable");

		if ($attr =~ /^(publish|build)/) {

			for my $repo (@qa_repos) {

				$writer->emptyTag("disable", repository => $repo);

			}

		}

		$writer->endTag($attr);

	}

	$writer->endTag("project");

	$writer->end();

	$self->put("/source/$project/_meta?force=1", $meta);

	my $prjconf = "";

	if ($options->{prjconf}) {

		$prjconf .= $options->{prjconf};

	}

	for my $package (@{$options->{remove_packages} || []}) {

		# OBS idiom: substitute the package by an empty set

		$prjconf .= "Substitute: $package\n";

	}

	for my $package (@{$options->{add_packages} || []}) {

		$prjconf .= "Support: $package\n";

	}

	$prjconf .= "Macros:\n";

	for my $macro (@{$options->{macros} || []}) {

		$prjconf .= "$macro\n";

	}

	$prjconf .= ":Macros\n";

	$self->put("/source/$project/_config", $prjconf);

	return { name => $project, qa_repos => \@qa_repos };

}

sub create_package {

	my ($self, $prj, $package, $title, $description) = @_;

	$title ||= $package;

	$description ||= "";

	my $meta;

	my $writer = XML::Writer->new(OUTPUT => \$meta);

	$writer->startTag("package", project => $prj->{name}, name => $package);

	$writer->dataElement("title", $title);

	$writer->dataElement("description", $description);

	# XXX: HACK

	if ($package =~ /^kernel-obs-(qa|build)/) {

		$writer->startTag("build");

		$writer->emptyTag("disable");

		for my $repo (@{$prj->{qa_repos} || []}) {

			$writer->emptyTag("enable", repository => $repo);

		}

		$writer->endTag("build");

	}

	$writer->endTag("package");

	$writer->end();

	$self->put("/source/$prj->{name}/$package/_meta", $meta);

}

# Get a list of links to this package within the same project

sub local_links {

	my ($self, $project, $package) = @_;

	my $xml = $self->post("/source/$project/$package?cmd=showlinked");

	my $handle_start = sub  {

		my ($self, $element, %attr) = @_;

		return unless $element eq "package";

		return unless exists($attr{project}) && exists($attr{name});

		if ($attr{project} eq $project && $attr{name} ne $package) {

			push(@{$self->{res}}, $attr{name});

		}

	};

	my $p = XML::Parser->new(Handlers => {Start => $handle_start});

	$p->{res} = [];

	$p->parse($xml);

	return @{$p->{res}};

}

sub get_directory_revision {

	my ($self, $xml) = @_;

	my $handle_start = sub {

		my ($self, $element, %attr) = @_;

		return unless $element eq "directory";

		$self->{res}[0] = $attr{rev};

	};

	my $p = XML::Parser->new(Handlers => {Start => $handle_start});

	$p->{res} = [];

	$p->parse($xml);

	return $p->{res}[0];

}

sub upload_package {

	my ($self, $dir, $prj, $package, $commit, $options) = @_;

	$options ||= {};

	my $progresscb = $options->{progresscb} || sub { };

	my $no_init = $options->{no_init};

	my $remove_packages = $options->{remove_packages} || [];

	my %remove_packages = map { $_ => 1 } @$remove_packages;

	my $limit_packages = $options->{limit_packages} || [];

	my %limit_packages = map { $_ => 1 } @$limit_packages;

	my $do_limit_packages = (scalar(@$limit_packages) > 0);

	my $extra_links = $options->{extra_links} || [];

	my %specfiles = map { $_ => 1 } @$extra_links;

	my $revision;

	if (!ref($prj)) {

		$prj = { name => $prj };

	}

	my $project = $prj->{name};

	if (!$self->project_exists($project)) {

		die "Project $project does not exist\n";

	}

	if (!$no_init) {

		$self->create_package($prj, $package);

		&$progresscb('CREATE', "$project/$package");

	}

	opendir(my $dh, $dir) or die "$dir: $!\n";

	my $remote = $self->readdir("/source/$project/$package");

	my $new_filelist = "";

	my $filelist_writer = XML::Writer->new(OUTPUT => \$new_filelist);

	$filelist_writer->startTag("directory");

	my $changed = 0;

	while ((my $name = CORE::readdir($dh))) {

		my $local_path = "$dir/$name";

		my $remote_path = "/source/$project/$package/$name?rev=repository";

		next if $name =~ /^\./;

		next if ! -f $local_path;

		open(my $fh, '<', "$dir/$name") or die "$dir/$name: $!\n";

		my $md5 = Digest::MD5->new->addfile($fh)->hexdigest;

		$filelist_writer->emptyTag("entry", name => $name, md5 => $md5);

		if (!$remote->{$name} || $md5 ne $remote->{$name}->{md5}) {

			$self->put_file($local_path, $remote_path);

			&$progresscb('PUT', $name);

			$changed = 1;

		}

		if ($remote->{$name}) {

			delete $remote->{$name};

		}

		if ($name =~ /(.*)\.spec$/) {

			if ($1 ne $package) {

				$specfiles{$1} = 1;

			}

		}

	}

	closedir($dh);

	for my $name (keys(%$remote)) {

		$self->delete("/source/$project/$package/$name");

		&$progresscb('DELETE', $name);

		$changed = 1;

	}

	$filelist_writer->endTag("directory");

	$filelist_writer->end();

	if ($changed) {

		my $xml = $self->post("/source/$project/$package?comment=$commit&cmd=commitfilelist", $new_filelist);

		$revision = $self->get_directory_revision($xml);

	}

	if ($no_init) {

		return $revision;

	}

	# Create links for all specfiles in this package

	my %links = map { $_ => 1 } $self->local_links($project, $package);

	my $link_xml;

	my $writer = XML::Writer->new(OUTPUT => \$link_xml);

	$writer->emptyTag("link", project => $project, package => $package,

		cicount => "copy");

	$writer->end();

	for my $spec (keys(%specfiles)) {

		next if $remove_packages{$spec};

		next if $do_limit_packages && !$limit_packages{$spec};

		$self->create_package($prj, $spec);

		$self->put("/source/$project/$spec/_link", $link_xml);

		&$progresscb('LINK', "$project/$spec");

		delete($links{$spec});

	}

	# delete stale links

	for my $link (keys(%links)) {

		$self->delete("/source/$project/$link");

		&$progresscb('DELETE', "$project/$link");

	}

	# delete stale kernel-obs-build

	my $kob = "kernel-obs-build";

	$self->post("/build/$project?cmd=wipe&package=$kob");

	&$progresscb('WIPE', "$project $kob");

	return $revision;

}

sub submit_package {

	my ($self, $project, $package, $revision, $target, $comment) = @_;

	my $request;

	my $writer = XML::Writer->new(OUTPUT => \$request);

	$writer->startTag("request", type => "submit");

		$writer->startTag("submit");

			$writer->emptyTag("source",

				project => $project, package => $package,

				rev => $revision);

			$writer->emptyTag("target",

				project => $target, package => $package);

		$writer->endTag("submit");

		$writer->emptyTag("state", name => "new");

		$writer->dataElement("description", $comment);

	$writer->endTag("request");

	$writer->end();

	$self->post("/request?cmd=create", $request);

}

sub get_logfile {

	my ($self, $project, $package, $repository, $arch) = @_;

	$repository ||= "standard";

	return $self->get("/build/$project/$repository/$arch/$package/_log?nostream=1");

}

sub get_make_stderr {

	my ($self, $project, $package, $repository, $arch) = @_;

	$repository ||= "standard";

	return $self->get("/build/$project/$repository/$arch/$package/make-stderr.log");

}

sub get_kernel_commit {

	my ($self, $project, $package, $revision) = @_;

	my $content;

	for my $file (qw(source-timestamp build-source-timestamp)) {

		my $path = "/source/$project/$package/$file";

		$path .= "?rev=$revision" if $revision;

		eval {

			$content = $self->get($path);

		};

		last unless $@;

	}

	die "No timestamp file found in $project/$package\n" unless $content;

	if ($content !~ /^GIT Revision: ([0-9a-f]+)$/m) {

		die "Malformet timestamp file in $project/$package\n";

	}

	return $1;

}

sub get_results {

	my ($self, $project, $repository, $arch) = @_;

	my @params;

	push(@params, "repository=$repository") if $repository;

	push(@params, "arch=$arch") if $arch;

	my $xml = $self->get("/build/$project/_result?" . join("&", @params));

	return SUSE::MyBS::Buildresults->new($xml);

}

sub load_results {

	my ($self, $file) = @_;

	my $xml = "";

	local $/ = undef;

	if (open(my $fh, '<', $file)) {

		$xml = <$fh>;

	};

	return SUSE::MyBS::Buildresults->new($xml);

}

sub list_projects {

	my $self = shift;

	return keys(%{$self->readdir("/source")});

}

sub delete_project {

	my ($self, $project) = @_;

	return $self->delete("/source/$project?force=1");

}

1;