ACC SHELL
package SUSE::SRPrivate;
use strict;
use XML::Parser;
use XML::Writer;
use Data::Dumper;
use File::Temp qw(tempfile);
use File::Copy;
use Sys::Syslog;
use IPC::Open3;
use Fcntl qw(:DEFAULT);
use URI;
use URI::QueryParam;
use Time::HiRes qw(gettimeofday tv_interval);
use SUSE::Parser::RepoList;
use SUSE::Parser::ZmdConfig;
use SUSE::Parser::Product;
use SUSE::Parser::Pattern;
use WWW::Curl::Easy;
use English;
# client version number
our $SRversion = "1.4.0";
our @ISA = qw(Exporter);
our @EXPORT = qw(printLog);
sub readSystemValues
{
my $ctx = shift;
$ctx->{timeindent}++;
my $t0 = [gettimeofday] if($ctx->{time});
printLog($ctx, "info", indent($ctx)."START: readSystemValues") if($ctx->{time});
my $code = 0;
my $msg = "";
############### batch mode ########################
if($ctx->{batch})
{
# if --no-optional or --no-hw-data are not given in batch mode
# read the sysconfig values for the default
my $sysconfigOptional = "false";
my $sysconfigHWData = "false";
open(CNF, "< $ctx->{sysconfigFile}") and do {
while(<CNF>)
{
if($_ =~ /^\s*#/)
{
next;
}
elsif($_ =~ /^SUBMIT_OPTIONAL\s*=\s*"*([^"\s]*)"*\s*/ && defined $1 && $1 ne "")
{
$sysconfigOptional = $1;
}
elsif($_ =~ /^SUBMIT_HWDATA\s*=\s*"*([^"\s]*)"*\s*/ && defined $1 && $1 ne "")
{
$sysconfigHWData = $1;
}
}
close CNF;
};
if(!$ctx->{nooptional})
{
if(lc($sysconfigOptional) eq "true")
{
$ctx->{nooptional} = 0;
}
else
{
$ctx->{nooptional} = 1;
}
}
if(!$ctx->{nohwdata})
{
if(lc($sysconfigHWData) eq "true")
{
$ctx->{nohwdata} = 0;
}
else
{
$ctx->{nohwdata} = 1;
}
}
}
############### read the config ###################
if(-e $ctx->{configFile})
{
open(CNF, "< $ctx->{configFile}") or do
{
return logPrintReturn($ctx, "Cannot open file $ctx->{configFile}: $!\n", 12);
};
while(<CNF>)
{
if($_ =~ /^\s*#/)
{
next;
}
elsif($_ =~ /^url\s*=\s*(\S*)\s*/ && defined $1 && $1 ne "")
{
$ctx->{URL} = $1;
}
elsif($_ =~ /^listParams\s*=\s*(\S*)\s*/ && defined $1 && $1 ne "")
{
$ctx->{URLlistParams} = $1;
}
elsif($_ =~ /^listProducts\s*=\s*(\S*)\s*/ && defined $1 && $1 ne "")
{
$ctx->{URLlistProducts} = $1;
}
elsif($_ =~ /^register\s*=\s*(\S*)\s*/ && defined $1 && $1 ne "")
{
$ctx->{URLregister} = $1;
}
elsif($_ =~ /^hostGUID\s*=\s*(\w*)\s*/ && defined $1 && $1 ne "")
{
$ctx->{FallbackHostGUID} = $1;
}
elsif($_ =~ /^addRegSrvSrc\s*=\s*(\w*)\s*/ && defined $1)
{
if(lc($1) eq "true")
{
$ctx->{addRegSrvSrc} = 1;
}
else
{
$ctx->{addRegSrvSrc} = 0;
}
}
elsif($_ =~ /^addAdSrc\s*=\s*(\S*)\s*/ && defined $1 && $1 ne "")
{
push @{$ctx->{addAdSrc}}, $1;
}
}
close CNF;
}
############### GUID ##############################
($code, $msg) = initGUID($ctx);
if($code != 0)
{
return ($code, $msg);
}
printLog($ctx, "debug1", "GUID:$ctx->{guid}");
############### find Products #####################
($code, $msg) = getProducts($ctx);
if($code != 0)
{
return ($code, $msg);
}
########## host GUID (virtualization) #############
($code, $msg) = detectVirtualization($ctx);
if($code != 0)
{
return ($code, $msg);
}
############## some initial values ########################
$ctx->{args}->{processor} = { flag => "i", value => `$ctx->{uname} -p`, kind => "mandatory"};
$ctx->{args}->{platform} = { flag => "i", value => `$ctx->{uname} -i`, kind => "mandatory"};
$ctx->{args}->{timezone} = { flag => "i", value => "US/Mountain", kind => "mandatory"}; # default
open(SYSC, "< $ctx->{SYSCONFIG_CLOCK}") or do
{
return logPrintReturn($ctx, "Cannot open file $ctx->{SYSCONFIG_CLOCK}: $!\n", 12);
};
while(<SYSC>)
{
if($_ =~ /^TIMEZONE\s*=\s*"?([^"]*)"?/)
{
if(defined $1 && $1 ne "")
{
$ctx->{args}->{timezone} = { flag => "i", value => $1, kind => "mandatory"};
}
}
}
close SYSC;
chomp($ctx->{args}->{processor}->{value});
chomp($ctx->{args}->{platform}->{value});
printLog($ctx, "info", indent($ctx)."END: readSystemValues:".(tv_interval($t0))) if($ctx->{time});
$ctx->{timeindent}--;
return (0, "");
}
sub evaluateCommand
{
my $ctx = shift;
my $command = shift || undef;
my $mandatory = shift || 0;
my $cmd = undef;
my $out = undef;
my @arguments = ();
$ctx->{timeindent}++;
my $t0 = [gettimeofday] if($ctx->{time});
printLog($ctx, "info", indent($ctx)."START: evaluateCommand") if($ctx->{time});
if (!defined $command || $command eq "")
{
logPrintError($ctx, "Missing command.\n", 14);
return undef;
}
if ($command =~ /^hwinfo\s*(.*)\s*$/)
{
if(!$ctx->{nohwdata})
{
$cmd = $ctx->{hwinfo};
if (defined $1)
{
@arguments = split(/\s+/, $1);
}
}
elsif($ctx->{mandatory})
{
logPrintError($ctx, "Mandatory hardware data cannot be supplied because the option --no-hw-data was given.\n",
3);
return undef;
}
else
{
return "DISCARDED";
}
}
elsif ($command =~ /^lsb_release\s*(.*)\s*$/)
{
# maybe lsb_release is not installed
if(-e $ctx->{lsb_release})
{
$cmd = $ctx->{lsb_release};
if (defined $1)
{
@arguments = split(/\s+/, $1);
}
}
elsif($1 eq "-sd")
{
# needed for ostarget-bak;
# we should be able to return this even without lsb package installed.
my $line = "";
open(SR, "< /etc/SuSE-release") and do {
$line = <SR>;
chomp($line);
$line =~ s/^\s*//;
$line =~ s/\s*$//;
close SR;
};
if($line ne "")
{
return '"'.$line.'"';
}
return "";
}
else
{
return "";
}
}
elsif ($command =~ /^uname\s*(.*)\s*$/)
{
$cmd = $ctx->{uname};
if (defined $1)
{
@arguments = split(/\s+/, $1);
}
}
elsif ($command =~ /^zmd-secret$/)
{
$cmd = undef;
$out = $ctx->{secret};
}
elsif ($command =~ /^zmd-ostarget$/)
{
$cmd = undef;
my ($code, $msg) = zypperOSTarget($ctx);
if($code != 0)
{
logPrintError($ctx, $msg, $code);
return undef;
}
$out = $ctx->{ostarget};
}
elsif ($command =~ /^cpu-count$/)
{
$cmd = undef;
if(!$ctx->{nohwdata})
{
$out = cpuCount($ctx);
}
elsif($ctx->{mandatory})
{
logPrintError($ctx, "Mandatory hardware data cannot be supplied because the option --no-hw-data was given.\n",
3);
return undef;
}
else
{
return "DISCARDED";
}
}
elsif ($command =~ /^installed-langs$/)
{
$cmd = undef;
$out = installedLanguages($ctx);
}
elsif ($command =~ /^installed-desktops$/)
{
$cmd = undef;
if(!$ctx->{nohwdata})
{
my $kde = 0;
my $kde3 = 0;
my $kde4 = 0;
my $gnome = 0;
my $x11 = 0;
my @t = ();
if($#{$ctx->{installedPatterns}} == -1)
{
# ignore errors, getPatterns is not so important
getPatterns($ctx);
}
foreach my $pat (@{$ctx->{installedPatterns}})
{
if($pat eq "kde3_basis")
{
$kde3 = 1;
}
elsif($pat eq "kde4_basis")
{
$kde4 = 1;
}
elsif($pat =~ /gnome/)
{
$gnome = 1;
}
elsif($pat eq "x11")
{
$x11 = 1;
}
elsif($pat =~ /kde/)
{
$kde = 1;
}
}
push @t, "KDE3" if($kde3);
push @t, "KDE4" if($kde4);
push @t, "KDE" if($kde && ! $kde3 && ! $kde4);
push @t, "GNOME" if($gnome);
$out = join('+', @t);
if(@t == 0)
{
if( $x11 )
{
$out = "X11";
}
else
{
$out = "NOX11";
}
}
}
else
{
$out = "DISCARDED";
}
}
else
{
$out = "DISCARDED"; # command not allowed; reply DISCARDED
$cmd = undef;
}
if (defined $cmd)
{
my $code = 0;
my $err = "";
($code, $err, $out) = executeCommand($ctx, $cmd, undef, @arguments);
if(!defined $out || $out eq "")
{
$out = "";
}
printLog($ctx, "debug1", "LENGTH: ".length($out));
}
printLog($ctx, "info", indent($ctx)."END: evaluateCommand:".(tv_interval($t0))) if($ctx->{time});
$ctx->{timeindent}--;
return $out;
}
sub installedLanguages
{
my $ctx = shift;
my $code = 0;
my $err = "";
my $result = "";
my @languages = ('en_US');
$ctx->{timeindent}++;
my $t0 = [gettimeofday] if($ctx->{time});
printLog($ctx, "info", indent($ctx)."START: installedLanguages") if($ctx->{time});
my @cmdArgs = ("--no-refresh", "--quiet", "--non-interactive");
push @cmdArgs, "search", "-i", "yast2-trans-";
($code, $err, $result) = executeCommand($ctx, $ctx->{zypper}, undef, @cmdArgs);
if($code != 0)
{
$code += 30;
printLog($ctx, "error", "Query installed languages failed.($code) $err $result");
printLog($ctx, "info", indent($ctx)."END: installedLanguages:".(tv_interval($t0))) if($ctx->{time});
$ctx->{timeindent}--;
return "en_US";
}
else
{
foreach my $line (split(/\n/, $result))
{
next if($line =~ /^\s*$/);
next if($line !~ /^i/);
my @p = split(/\s*\|\s*/, $line);
if(defined $p[1] && $p[1] ne "" && $p[1] =~ /yast2-trans-([a-zA-Z_]+)/)
{
if(defined $1 && $1 ne "" && $1 ne "stats")
{
push @languages, $1;
}
}
}
}
printLog($ctx, "info", indent($ctx)."END: installedLanguages:".(tv_interval($t0))) if($ctx->{time});
$ctx->{timeindent}--;
return join(",", @languages);
}
sub cpuCount
{
my $ctx = shift;
$ctx->{timeindent}++;
my $t0 = [gettimeofday] if($ctx->{time});
printLog($ctx, "info", indent($ctx)."START: cpuCount") if($ctx->{time});
my $currentCPU = -1;
my $info = {};
my $haveCoreData = 0;
my $useCoreID = 0;
my $pid = -1; # processor id
my $cos = -1; # cores
my $cid = -1; # core id
my $out = "";
my $type = `uname -m`;
chomp($type);
if($type =~ /ppc/i)
{
my $sockets = `grep cpu /proc/device-tree/cpus/*/device_type | wc -l`;
$out = "CPUSockets: ".($sockets)."\n";
return $out;
}
my $cpuinfo = `cat /proc/cpuinfo`;
my @lines = split(/\n/, $cpuinfo);
foreach my $line (@lines)
{
if( $line =~ /^processor\s*:\s*(\d+)\s*$/)
{
if($pid >= 0 )
{
if($cos >= 0)
{
$info->{$pid} = $cos;
$pid = -1;
$cos = -1;
$cid = -1;
}
elsif($cid >= 0)
{
# IA64 does have core id but not cores
if(! exists $info->{$pid} || $cid > $info->{$pid})
{
$useCoreID = 1;
$info->{$pid} = $cid;
$pid = -1;
$cos = -1;
$cid = -1;
}
}
else
{
$out = "Read Error";
}
}
$currentCPU = $1;
}
elsif( $line =~ /^physical id\s*:\s*(\d+)\s*$/)
{
$haveCoreData = 1;
$pid = $1;
}
elsif( $line =~ /^cpu cores\s*:\s*(\d+)\s*$/)
{
$haveCoreData = 1;
$cos = $1;
}
elsif( $line =~ /^core id\s*:\s*(\d+)\s*$/)
{
$haveCoreData = 1;
$cid = $1;
}
elsif( $line =~ /^processor\s+(\d+):/)
{
# this is used for s390
$currentCPU = $1;
}
}
printLog($ctx, "debug2", " socket => cores ");
printLog($ctx, "debug2", Data::Dumper->Dump([$info]));
if(!$haveCoreData && $currentCPU >= 0)
{
$out = "CPUSockets: ".($currentCPU + 1)."\n";
}
elsif(keys %{$info} > 0)
{
my $cores = 0;
foreach my $s (keys %{$info})
{
$cores += $info->{$s};
if($useCoreID)
{
$cores += 1;
}
}
$out = "CPUSockets: ".(keys %{$info})."\nCPUCores : $cores\n"
}
else
{
$out = "Read Error";
}
printLog($ctx, "debug2", $out );
printLog($ctx, "info", indent($ctx)."END: cpuCount:".(tv_interval($t0))) if($ctx->{time});
$ctx->{timeindent}--;
return $out;
}
sub evalNeedinfo
{
my $ctx = shift;
my $tree = shift || undef;
my $logic = shift || "";
my $indent = shift || "";
my $mandatory = shift || 0;
my $modified = shift || 0;
$ctx->{timeindent}++;
my $t0 = [gettimeofday] if($ctx->{time});
printLog($ctx, "info", indent($ctx)."START: evalNeedinfo") if($ctx->{time});
my $mandstr = "";
my $nextLogic = $logic;
if($#{$ctx->{registerReadableText}} >= 0)
{
$indent = $indent." ";
}
if (! defined $tree)
{
logPrintError($ctx, "Missing data.\n", 14);
return $modified;
}
printLog($ctx, "debug3", "LOGIC: $logic");
printLog($ctx, "debug3", Data::Dumper->Dump([$tree]));
foreach my $kid (@$tree)
{
my $local_mandatory = $mandatory;
if (ref($kid) eq "SR::param")
{
if (@{$kid->{Kids}} > 1)
{
$nextLogic = "AND";
}
if($logic eq "")
{
$logic = $nextLogic;
}
}
elsif (ref($kid) eq "SR::select")
{
$nextLogic = "OR";
if($logic eq "")
{
$logic = $nextLogic;
}
}
elsif (ref($kid) eq "SR::privacy")
{
if (exists $kid->{description} && defined $kid->{description})
{
if(!$ctx->{yastcall})
{
$ctx->{registerPrivPol} .= "\nInformation on Novell's Privacy Policy:\n";
$ctx->{registerPrivPol} .= $kid->{description}."\n";
}
else
{
$ctx->{registerPrivPol} .= "<p>Information on Novell's Privacy Policy:<br>\n";
$ctx->{registerPrivPol} .= $kid->{description}."</p>\n";
}
}
if (exists $kid->{url} && defined $kid->{url} && $kid->{url} ne "")
{
if(!$ctx->{yastcall})
{
$ctx->{registerPrivPol} .= $kid->{url}."\n";
}
else
{
$ctx->{registerPrivPol} .= "<p><a href=\"".$kid->{url}."\">";
$ctx->{registerPrivPol} .= $kid->{url}."</a></p>\n";
}
}
}
elsif (ref($kid) eq "SR::needinfo")
{
# do nothing
}
else
{
# skip host, guid, product and maybe more to come later.
# There are no strings for the user to display.
next;
}
if (exists $kid->{class} &&
defined $kid->{class} &&
$kid->{class} eq "mandatory")
{
$local_mandatory = 1;
$mandstr = "(mandatory)";
printLog($ctx, "debug3", "Found mandatory");
}
elsif(!$local_mandatory &&
!exists $kid->{class})
{
$mandstr = "(optional)";
}
if (ref($kid) ne "SR::privacy" &&
@{$kid->{Kids}} == 0 &&
defined $kid->{description} &&
defined $kid->{id})
{
if ( ($ctx->{nooptional} && $local_mandatory) || !$ctx->{nooptional})
{
if(! exists $kid->{command})
{
printLog($ctx, "debug3", "Add instruction");
my $txt = $indent."* ".$kid->{description}." $mandstr";
$ctx->{args}->{$kid->{id}} = { flag => "m",
value => undef,
kind => ($local_mandatory)?"mandatory":"optional"};
if(!$ctx->{yastcall})
{
$txt .= ":\t".$kid->{id}."=<value>\n";
}
else
{
$txt .= "\n";
}
push @{$ctx->{registerReadableText}}, $txt;
}
else
{
my $ret = evaluateCommand($ctx, $kid->{command}, $local_mandatory);
if($ctx->{errorcode} != 0)
{
return $modified;
}
if (defined $ret)
{
$ctx->{args}->{$kid->{id}} = { flag => "a",
value => $ret,
kind => ($local_mandatory)?"mandatory":"optional"
};
$modified = 1;
}
}
}
}
elsif (ref($kid) ne "SR::privacy" && defined $kid->{description})
{
if ( ($ctx->{nooptional} && $local_mandatory) || !$ctx->{nooptional})
{
printLog($ctx, "debug3", "Add description");
push @{$ctx->{registerReadableText}}, $indent.$kid->{description}." $mandstr with:\n";
}
}
if ( exists $kid->{Kids} && @{$kid->{Kids}} > 0 )
{
$modified = evalNeedinfo($ctx, $kid->{Kids}, $nextLogic, $indent, $local_mandatory, $modified);
$nextLogic = $logic;
if (defined $ctx->{registerReadableText}->[$#{$ctx->{registerReadableText}}] &&
$ctx->{registerReadableText}->[$#{$ctx->{registerReadableText}}] =~ /^\s*AND|OR\s*$/i)
{
if ($logic =~ /^\s*$/)
{
pop @{$ctx->{registerReadableText}};
}
else
{
$ctx->{registerReadableText}->[$#{$ctx->{registerReadableText}}] = $indent."$logic\n";
}
}
else
{
push @{$ctx->{registerReadableText}}, $indent."$logic\n";
}
}
}
printLog($ctx, "info", indent($ctx)."END: evalNeedinfo:".(tv_interval($t0))) if($ctx->{time});
$ctx->{timeindent}--;
return $modified;
}
#sub walkResultZmdconfig
sub buildXML
{
my $ctx = shift;
$ctx->{timeindent}++;
my $t0 = [gettimeofday] if($ctx->{time});
printLog($ctx, "info", indent($ctx)."START: buildXML") if($ctx->{time});
my $output = '<?xml version="1.0" encoding="utf-8"?>';
my $writer = new XML::Writer(OUTPUT => \$output);
my %a = ("xmlns" => "http://www.novell.com/xml/center/regsvc-1_0",
"client_version" => "$SRversion");
if(!$ctx->{nooptional})
{
$a{accept} = "optional";
}
if($ctx->{acceptmand} || $ctx->{nooptional})
{
$a{accept} = "mandatory";
}
if($ctx->{forcereg})
{
$a{force} = "registration";
}
if($ctx->{batch})
{
$a{force} = "batch";
}
$writer->startTag("register", %a);
$writer->startTag("guid");
$writer->characters($ctx->{guid});
$writer->endTag("guid");
if(defined $ctx->{virtType} && $ctx->{virtType} ne "")
{
if(defined $ctx->{hostGUID} && $ctx->{hostGUID} ne "")
{
$writer->startTag("host", type => $ctx->{virtType} );
$writer->characters($ctx->{hostGUID});
$writer->endTag("host");
}
else
{
$writer->emptyTag("host", type => $ctx->{virtType});
}
}
else
{
$writer->emptyTag("host");
}
foreach my $PArray (@{$ctx->{products}})
{
if(defined $PArray->[0] && $PArray->[0] ne "" &&
defined $PArray->[1] && $PArray->[1] ne "")
{
$writer->startTag("product",
"version" => $PArray->[1],
"release" => $PArray->[2],
"arch" => $PArray->[3]);
if ($PArray->[0] =~ /\s+/)
{
$writer->cdata($PArray->[0]);
}
else
{
$writer->characters($PArray->[0]);
}
$writer->endTag("product");
}
}
foreach my $key (keys %{$ctx->{args}})
{
next if(!defined $ctx->{args}->{$key}->{value});
if($ctx->{args}->{$key}->{value} eq "")
{
$writer->emptyTag("param", "id" => $key);
}
else
{
$writer->startTag("param",
"id" => $key);
my $value = $ctx->{args}->{$key}->{value};
$value =~ s/[\x00-\x08\x0B-\x0C\x0E-\x1F]/ /g;
if ($value =~ /\s+/)
{
$writer->cdata($value);
}
else
{
$writer->characters($value);
}
$writer->endTag("param");
}
}
$writer->endTag("register");
printLog($ctx, "debug3", "XML:\n$output");
printLog($ctx, "info", indent($ctx)."END: buildXML:".(tv_interval($t0))) if($ctx->{time});
$ctx->{timeindent}--;
return $output;
}
sub sendData
{
my $ctx = shift;
my $url = shift || undef;
my $data = shift || undef;
$ctx->{timeindent}++;
my $t0 = [gettimeofday] if($ctx->{time});
printLog($ctx, "info", indent($ctx)."START: sendData") if($ctx->{time});
my $curlErr = 0;
my $res = "";
my $err = "";
my %header = ();
my $code = "";
my $mess = "";
my $content = "";
my $header = "";
if (! defined $url)
{
logPrintError($ctx, "Cannot send data to registration server. Missing URL.\n", 14);
return;
}
if($url =~ /^-/)
{
logPrintError($ctx, "Invalid protocol($url).\n", 15);
return;
}
my $uri = URI->new($url);
if(!defined $uri->host || $uri->host !~ /$ctx->{initialDomain}$/)
{
logPrintError($ctx, "Invalid URL($url). Data could only be send to $ctx->{initialDomain} .\n", 15);
return;
}
if(!defined $uri->scheme || $uri->scheme ne "https")
{
logPrintError($ctx, "Invalid protocol($url). https is required.\n", 15);
return;
}
$url = $uri->as_string;
if (! defined $data)
{
logPrintError($ctx, "Cannot send data. Missing data.\n", 14);
return;
}
my ($httpProxy, $httpsProxy, $proxyUser) = getProxySettings();
$ctx->{curlobj} = WWW::Curl::Easy->new();
$ctx->{curlobj}->setopt(CURLOPT_HEADER,0);
$ctx->{curlobj}->setopt(CURLOPT_VERBOSE, 1);
$ctx->{curlobj}->setopt(CURLOPT_DEBUGFUNCTION, sub {
my $text = shift;
my $unknown = shift;
my $type = shift;
if($type == 0)
{
chomp($text);
printLog($ctx, "debug2", "$text" );
}
#else
#elsif($type != 5 && $type != 6)
#{
# chomp($text);
# printLog($ctx, "debug3", "d3>$text" );
#}
return 0;
});
$ctx->{curlobj}->setopt(CURLOPT_URL, "$url");
$ctx->{curlobj}->setopt(CURLOPT_PROTOCOLS, 2);
if(defined $httpsProxy && $httpsProxy ne "")
{
$ctx->{curlobj}->setopt(CURLOPT_PROXY, $httpsProxy);
$ctx->{curlobj}->setopt(CURLOPT_PROXY_TRANSFER_MODE, 1);
if(defined $proxyUser && $proxyUser ne "")
{
$ctx->{curlobj}->setopt(CURLOPT_PROXYAUTH, 1);
$ctx->{curlobj}->setopt(CURLOPT_PROXYUSERPWD, $proxyUser);
}
}
$ctx->{curlobj}->setopt(CURLOPT_POSTFIELDS, $data);
$ctx->{curlobj}->setopt(CURLOPT_POSTFIELDSIZE, length($data));
$ctx->{curlobj}->setopt(CURLOPT_POST, 1);
$ctx->{curlobj}->setopt(CURLOPT_CONNECTTIMEOUT, 20);
$ctx->{curlobj}->setopt(CURLOPT_TIMEOUT, 150);
$ctx->{curlobj}->setopt(CURLOPT_CAPATH, "/etc/ssl/certs/");
$ctx->{curlobj}->setopt(CURLOPT_SSL_VERIFYHOST, 2);
$ctx->{curlobj}->setopt(CURLOPT_SSL_VERIFYPEER, 1);
printLog($ctx, "debug2", "SEND DATA to URI: $url:", 1, 0);
printLog($ctx, "debug2", "$data", 1, 0);
printLog($ctx, "info", "SEND DATA to URI: $url:", 0, 1);
printLog($ctx, "info", "$data", 0, 1);
open (my $fileb, ">", \$content);
$ctx->{curlobj}->setopt(CURLOPT_WRITEDATA,$fileb);
open (my $headerb, ">", \$header);
$ctx->{curlobj}->setopt(CURLOPT_WRITEHEADER,$headerb);
my $retcode = $ctx->{curlobj}->perform;
close $fileb;
close $headerb;
if ($retcode != 0)
{
logPrintError($ctx, "ERROR: ".$ctx->{curlobj}->strerror($retcode).": ($retcode)\n", 2);
logPrintError($ctx, "ERROR: $header\n", 2);
#printLog($ctx, "debug2", $@, 1, 0);
#printLog($ctx, "error", $@, 0, 1);
return undef;
}
my $response_code = $ctx->{curlobj}->getinfo(CURLINFO_RESPONSE_CODE);
$header{code} = $response_code;
foreach my $line (split(/\n/, $header))
{
if($line =~ /^HTTP\/([\d.]+)\s+$response_code\s+(.+)\s*$/)
{
$header{httpversion} = $1;
$header{message} = $2;
}
elsif($line =~ /^([^:]+):\s*(.+)\s*$/)
{
$header{lc($1)} = $2;
}
}
$mess = $header{message} if(exists $header{message});
printLog($ctx, "debug2", "CODE: ".$response_code." MESSAGE: $mess", 1, 0);
printLog($ctx, "debug2", "RECEIVED DATA:", 1, 0);
printLog($ctx, "debug2", "$header\n$content", 1, 0);
printLog($ctx, "info", "CODE: ".$response_code." MESSAGE: $mess",0,1);
printLog($ctx, "info", "RECEIVED DATA:", 0, 1);
printLog($ctx, "info", "$header\n$content", 0, 1);
if( $response_code == 301 || $response_code == 302)
{
if ($ctx->{redirects} > 5)
{
logPrintError($ctx, "Too many redirects. Aborting.\n", 5);
return $res;
}
$ctx->{redirects}++;
my $loc = $header{location};
local $/ = "\r\n";
chomp($loc);
local $/ = "\n";
#print STDERR "sendData(redirect): ".(tv_interval($t0))."\n" if($ctx->{time});
$content = sendData($ctx, $loc, $data);
}
elsif($response_code < 200 || $response_code >= 300)
{
my $b = "";
my @c = ();
if(-e "/usr/bin/lynx")
{
$b = "/usr/bin/lynx";
push @c, "-dump", "-stdin";
}
elsif(-e "/usr/bin/w3m")
{
$b = "/usr/bin/w3m";
push @c, "-dump", "-T", "text/html";
}
my $out = "";
if(-x $b)
{
my $code = 0;
my $err = "";
($code, $err, $out) = executeCommand($ctx, $b, $content ,@c);
$out .= "\n";
if(defined $err && $err ne "")
{
$out .= "$err\n";
}
}
$out .= "$response_code $mess\n";
logPrintError($ctx, "ERROR: ".$response_code.": $out\n", 2);
$content = undef;
}
printLog($ctx, "info", indent($ctx)."END: sendData:".(tv_interval($t0))) if($ctx->{time});
$ctx->{timeindent}--;
return $content;
}
sub getProxySettings
{
my $httpProxy = undef;
my $httpsProxy = undef;
my $proxyUser = undef;
if(exists $ENV{http_proxy} && defined $ENV{http_proxy} && $ENV{http_proxy} =~ /^http/)
{
$httpProxy = $ENV{http_proxy};
}
if(exists $ENV{https_proxy} && defined $ENV{https_proxy} && $ENV{https_proxy} =~ /^http/)
{
# required for Crypt::SSLeay HTTPS Proxy support
$httpsProxy = $ENV{https_proxy};
}
if($UID == 0 && -e "/root/.curlrc")
{
# read /root/.curlrc
open(RC, "< /root/.curlrc") or return (undef,undef);
while(<RC>)
{
if($_ =~ /^\s*proxy-user\s*=\s*"(.+)"\s*$/ && defined $1 && $1 ne "")
{
$proxyUser = $1;
}
elsif($_ =~ /^\s*--proxy-user\s+"(.+)"\s*$/ && defined $1 && $1 ne "")
{
$proxyUser = $1;
}
}
close RC;
}
elsif($UID != 0 &&
exists $ENV{HOME} && defined $ENV{HOME} &&
$ENV{HOME} ne "" && -e "$ENV{HOME}/.curlrc")
{
# read ~/.curlrc
open(RC, "< $ENV{HOME}/.curlrc") or return (undef,undef);
while(<RC>)
{
if($_ =~ /^\s*proxy-user\s*=\s*"(.+)"\s*$/ && defined $1 && $1 ne "")
{
$proxyUser = $1;
}
elsif($_ =~ /^\s*--proxy-user\s+"(.+)"\s*$/ && defined $1 && $1 ne "")
{
$proxyUser = $1;
}
}
close RC;
}
# strip trailing /
$httpsProxy =~ s/\/*$// if(defined $httpsProxy);
$httpProxy =~ s/\/*$// if(defined $httpProxy);
return ($httpProxy, $httpsProxy, $proxyUser);
}
sub getPatterns
{
my $ctx = shift;
$ctx->{timeindent}++;
my $t0 = [gettimeofday] if($ctx->{time});
printLog($ctx, "info", indent($ctx)."START: getPatterns") if($ctx->{time});
my $code = 0;
my $err = "";
my $result = "";
my @cmdArgs = ("--no-refresh", "--quiet", "--xmlout", "--non-interactive");
push @cmdArgs, "patterns", "--installed-only";
($code, $err, $result) = executeCommand($ctx, $ctx->{zypper}, undef, @cmdArgs);
if($code != 0)
{
$code += 30;
}
else
{
my $parser = SUSE::Parser::Pattern->new(ctx => $ctx);
$code = $parser->parse($result, sub { pattern_handler($ctx, @_)});
}
printLog($ctx, "debug1", "Query patterns failed($code): $err $result") if($code != 0);
printLog($ctx, "debug1", "installed patterns: ".Data::Dumper->Dump([$ctx->{installedPatterns}]));
printLog($ctx, "info", indent($ctx)."END: getPatterns:".(tv_interval($t0))) if($ctx->{time});
$ctx->{timeindent}--;
return logPrintReturn($ctx, "Query patterns failed: $err $result", $code);
}
sub pattern_handler
{
my $ctx = shift;
my $data = shift;
printLog($ctx, "debug3", "pattern_hander: ".Data::Dumper->Dump([$data]));
return if(!exists $data->{INSTALLED} || ! defined $data->{INSTALLED} || $data->{INSTALLED} ne "1");
return if(!exists $data->{NAME} || ! defined $data->{NAME} || $data->{NAME} eq "");
push @{$ctx->{installedPatterns}}, $data->{NAME};
}
sub getProducts
{
my $ctx = shift;
$ctx->{timeindent}++;
my $t0 = [gettimeofday] if($ctx->{time});
printLog($ctx, "info", indent($ctx)."START: getProducts") if($ctx->{time});
my $code = 0;
my $err = "";
my $result = "";
my @cmdArgs = ("--no-refresh", "--quiet", "--xmlout", "--non-interactive");
push @cmdArgs, "products", "--installed-only";
($code, $err, $result) = executeCommand($ctx, $ctx->{zypper}, undef, @cmdArgs);
if($code != 0)
{
$code += 30;
}
else
{
my $parser = SUSE::Parser::Product->new(ctx => $ctx);
$code = $parser->parse($result, sub { product_handler($ctx, @_)});
}
printLog($ctx, "debug1", "Query products failed($code): $err $result") if($code != 0);
printLog($ctx, "debug1", "installed products: ".Data::Dumper->Dump([$ctx->{installedProducts}]));
syslog("info", "Installed Products Dump: ".Data::Dumper->Dump([$ctx->{installedProducts}]));
printLog($ctx, "info", indent($ctx)."END: getProducts:".(tv_interval($t0))) if($ctx->{time});
$ctx->{timeindent}--;
return logPrintReturn($ctx, "Query products failed: $err $result", $code);
}
sub product_handler
{
my $ctx = shift;
my $data = shift;
printLog($ctx, "debug3", "product_hander: ".Data::Dumper->Dump([$data]));
return if(!exists $data->{INSTALLED} || ! defined $data->{INSTALLED} || $data->{INSTALLED} ne "1");
return if(!exists $data->{REPO} || ! defined $data->{REPO} || $data->{REPO} ne '@System');
return if(!exists $data->{NAME} || ! defined $data->{NAME} || $data->{NAME} eq "");
return if(!exists $data->{VERSION} || ! defined $data->{VERSION} || $data->{VERSION} eq "");
if(!exists $data->{ARCH} || !defined $data->{ARCH} ||
$data->{ARCH} eq "" || $data->{ARCH} eq "noarch")
{
$data->{ARCH} = `$ctx->{uname} -m`;
chomp($data->{ARCH});
}
if($data->{ARCH} eq "i386" || $data->{ARCH} eq "i486")
{
$data->{ARCH} = "i586";
}
elsif($data->{ARCH} eq "s390")
{
$data->{ARCH} = "s390x";
}
elsif($data->{ARCH} eq "ppc")
{
$data->{ARCH} = "ppc64";
}
my $release = "";
# search for overwrite file
if(exists $data->{PRODUCTLINE} && defined $data->{PRODUCTLINE} &&
$data->{PRODUCTLINE} ne "" && -s "/var/lib/suseRegister/OEM/$data->{PRODUCTLINE}" )
{
open(CNF, "< /var/lib/suseRegister/OEM/".$data->{PRODUCTLINE}) and do
{
$release = <CNF>;
chomp($release);
close CNF;
};
}
# if not, look for REGISTERRELEASE
if($release eq "" && exists $data->{REGISTERRELEASE} && defined $data->{REGISTERRELEASE})
{
$release = $data->{REGISTERRELEASE};
}
# if not, look for FLAVOR
if($release eq "" && exists $data->{FLAVOR} && defined $data->{FLAVOR})
{
$release = $data->{FLAVOR};
}
push @{$ctx->{installedProducts}}, ["$data->{NAME}", "$data->{VERSION}", "$release", "$data->{ARCH}"];
}
sub getZmdConfigValues
{
my $ctx = shift;
$ctx->{timeindent}++;
my $t0 = [gettimeofday] if($ctx->{time});
printLog($ctx, "info", indent($ctx)."START: getZmdConfigValues") if($ctx->{time});
if($ctx->{addRegSrvSrc})
{
# parse the new zmdconfig from registration service
my $parser = SUSE::Parser::ZmdConfig->new(ctx => $ctx);
$ctx->{zmdConfig} = $parser->parse($ctx->{newzmdconfig});
}
foreach my $src (@{$ctx->{addAdSrc}})
{
# add local configured repos from suseRegister.conf
my $uri = URI->new($src);
my $alias = $uri->query_param("alias");
$ctx->{zmdConfig}->{$src}->{'URL'} = $src;
$ctx->{zmdConfig}->{$src}->{'TYPE'} = "zypp";
if(defined $alias && $alias ne "")
{
$ctx->{zmdConfig}->{$src}->{'ALIAS'} = $alias;
}
}
printLog($ctx, "debug2", "zmdconfig: ".Data::Dumper->Dump([$ctx->{zmdConfig}]));
printLog($ctx, "info", indent($ctx)."END: getZmdConfigValues:".(tv_interval($t0))) if($ctx->{time});
$ctx->{timeindent}--;
return (0, "");
}
sub saveLastZmdConfig
{
my $ctx = shift;
#my $zmdconfig = shift || undef;
if(!exists $ctx->{newzmdconfig} || !defined $ctx->{newzmdconfig})
{
return logPrintReturn($ctx, "Missing data.\n", 14);
}
if(!-d "/var/cache/SuseRegister/")
{
mkdir "/var/cache/SuseRegister/";
}
# make a backup of the old cache file
if(-e $ctx->{zmdcache})
{
copy($ctx->{zmdcache}, $ctx->{zmdcache}.".old");
}
open(OUT, "> ".$ctx->{zmdcache}) or return logPrintReturn($ctx, "Cannot open cache file '$ctx->{zmdcache}': $!", 12);
print OUT $ctx->{newzmdconfig};
close OUT;
return (0, "");
}
sub readLastZmdConfig
{
my $ctx = shift;
my $xml = "";
$ctx->{timeindent}++;
my $t0 = [gettimeofday] if($ctx->{time});
printLog($ctx, "info", indent($ctx)."START: readLastZmdConfig") if($ctx->{time});
$ctx->{"lastZmdConfig"} = undef;
if(-e $ctx->{zmdcache})
{
open(CACHE, "< $ctx->{zmdcache}") and do {
$xml = join('', <CACHE>);
close CACHE;
};
eval {
my $parser = SUSE::Parser::ZmdConfig->new(ctx => $ctx);
$ctx->{lastZmdConfig} = $parser->parse($xml);
};
if($@)
{
# ignore errors but print them
printLog($ctx, "warn", "readLastZmdConfig parsing error: $@");
$ctx->{lastZmdConfig} = undef;
}
}
printLog($ctx, "info", indent($ctx)."END: readLastZmdConfig:".(tv_interval($t0))) if($ctx->{time});
$ctx->{timeindent}--;
return (0, "");
}
sub logPrintReturn
{
my $ctx = shift;
my $message = shift || "";
my $code = shift || 0;
if($code != 0)
{
syslog("err", "$message($code)");
printLog($ctx, "error", "$message($code)");
}
# cleanup errors in the context
$ctx->{errorcode} = 0;
$ctx->{errormsg} = "";
return ($code, $message);
}
sub logPrintError
{
my $ctx = shift;
my $message = shift || "";
my $code = shift || 0;
if($code != 0)
{
if(exists $ctx->{args}->{password})
{
$ctx->{args}->{password}->{value} = "secret";
}
if(exists $ctx->{args}->{passwd})
{
$ctx->{args}->{passwd}->{value} = "secret";
}
if(exists $ctx->{args}->{secret})
{
$ctx->{args}->{secret}->{value} = "secret";
}
my $cmdtxt = "Commandline params: no-optional:$ctx->{nooptional} forceregistration:$ctx->{forcereg} ";
$cmdtxt .= "no-hw-data:$ctx->{nohwdata} batch:$ctx->{batch} ";
syslog("err", $cmdtxt);
syslog("err", "Argument Dump: ".Data::Dumper->Dump([$ctx->{args}]));
syslog("err", "Products Dump: ".Data::Dumper->Dump([$ctx->{products}]));
syslog("err", "$message($code)");
printLog($ctx, "error", "$message($code)");
}
$ctx->{errorcode} = $code;
$ctx->{errormsg} = $message;
return;
}
sub printLog
{
my $ctx = shift;
my $category = shift;
my $message = shift;
my $doprint = shift;
my $dolog = shift;
if (! defined $doprint) { $doprint = 1;}
if (! defined $dolog) { $dolog = 1;}
return if($ctx->{debug} == 2 && $category eq "debug3");
return if($ctx->{debug} == 1 && ($category eq "debug2" || $category eq "debug3"));
return if(!$ctx->{debug} && ($category eq "debug1" || $category eq "debug2" || $category eq "debug3"));
if($doprint && !$ctx->{yastcall})
{
if(lc($category) eq "error")
{
print STDERR "$message\n";
}
else
{
print "$message\n";
}
}
if($dolog && defined $ctx->{LOGDESCR})
{
my ($package, $filename, $line) = caller;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
$year += 1900;
$mon +=1;
my $timestamp = sprintf("%04d-%02d-%02d %02d:%02d:%02d", $year,$mon,$mday, $hour,$min,$sec);
my $LOG = $ctx->{LOGDESCR};
foreach (split(/\n/, $message))
{
print $LOG "$timestamp $package - [$category] $_\n";
}
}
return;
}
sub listProducts
{
my $ctx = shift;
$ctx->{timeindent}++;
my $t0 = [gettimeofday] if($ctx->{time});
printLog($ctx, "info", indent($ctx)."START: listProducts") if($ctx->{time});
my $output = "\n";
my $writer = new XML::Writer(OUTPUT => \$output);
$ctx->{redirects} = 0;
my $res = sendData($ctx, $ctx->{URL}."?".$ctx->{URLlistProducts}."&lang=en-US&version=$ctx->{version}", $output);
if($ctx->{errorcode} != 0 || ! defined $res)
{
return ($ctx->{errorcode}, $ctx->{errormsg});
}
my $p = new XML::Parser(Style => 'Objects', Pkg => 'SR');
my $tree = $p->parse($res);
#print Data::Dumper->Dump([$tree])."\n";
if (! defined $tree || ref($tree->[0]) ne "SR::productlist")
{
return logPrintReturn($ctx, "Unknown XML format. Cannot show human readable output. Try --xml-output.\n",
6);
}
foreach my $kid (@{$tree->[0]->{Kids}})
{
#print Data::Dumper->Dump([$kid])."\n";
if (ref($kid) eq "SR::product" &&
exists $kid->{Kids} &&
exists $kid->{Kids}->[0] &&
ref($kid->{Kids}->[0]) eq "SR::Characters" &&
exists $kid->{Kids}->[0]->{Text} &&
defined $kid->{Kids}->[0]->{Text} &&
$kid->{Kids}->[0]->{Text} ne "")
{
#print "SEE:".Data::Dumper->Dump([$tree->[1]->[$i]])."\n\n";
push @{$ctx->{serverKnownProducts}}, [$kid->{Kids}->[0]->{Text}, "0"];
}
}
printLog($ctx, "debug2", "Server Known Products:".Data::Dumper->Dump([$ctx->{serverKnownProducts}]));
printLog($ctx, "info", indent($ctx)."END: listProducts:".(tv_interval($t0))) if($ctx->{time});
$ctx->{timeindent}--;
return (0, "");
}
sub intersection
{
my $ctx = shift;
my $arr1 = shift || undef;
my $arr2 = shift || undef;
my $ret = [];
if(!defined $arr1 || !defined $arr2 ||
ref($arr1->[0]) ne "ARRAY" || ref($arr2->[0]) ne "ARRAY")
{
return [];
}
printLog($ctx, "debug3", "intersect1: ".Data::Dumper->Dump([$arr1]));
printLog($ctx, "debug3", "intersect2: ".Data::Dumper->Dump([$arr2]));
foreach my $v1 (@$arr1)
{
foreach my $v2 (@$arr2)
{
if(lc($v1->[0]) eq lc($v2->[0]))
{
if($v2->[1] ne "0")
{
push @$ret, $v2;
}
else
{
push @$ret, $v1;
}
last;
}
}
}
printLog($ctx, "debug3", "intersect return : ".Data::Dumper->Dump([$ret]));
return $ret;
}
sub currentServices
{
my $ctx = shift;
my $code = 1;
my $msg = "";
my $xml = "";
$ctx->{timeindent}++;
my $t0 = [gettimeofday] if($ctx->{time});
printLog($ctx, "info", indent($ctx)."START: currentServices") if($ctx->{time});
my @cmdArgs = ("--no-refresh", "--quiet", "--xmlout", "--non-interactive");
push @cmdArgs, "services", "--with-repos";
($code, $msg, $xml) = executeCommand($ctx, $ctx->{zypper}, undef, @cmdArgs);
if($code != 0)
{
$code += 30;
}
my $self = {};
my $parser = SUSE::Parser::RepoList->new(ctx => $ctx);
$parser->parse($xml, sub { repolist_handler($self, $ctx, @_)});
printLog($ctx, "info", indent($ctx)."END: currentServices:".(tv_interval($t0))) if($ctx->{time});
$ctx->{timeindent}--;
return (0, "");
}
sub repolist_handler
{
my $self = shift;
my $ctx = shift;
my $data = shift;
printLog($ctx, "debug3", "repolist_handler: ".Data::Dumper->Dump([$data]));
$ctx->{currentSources}->{$data->{ALIAS}}->{URL} = $data->{URL};
$ctx->{currentSources}->{$data->{ALIAS}}->{TYPE} = $data->{TYPE};
$ctx->{currentSources}->{$data->{ALIAS}}->{ALIAS} = $data->{ALIAS};
$ctx->{currentSources}->{$data->{ALIAS}}->{NAME} = $data->{NAME};
# if CATALOGS do not exists wer are finished
return if ( ! exists $data->{CATALOGS} );
foreach my $catname ( keys %{$data->{CATALOGS}} )
{
foreach my $key ( keys %{$data->{CATALOGS}->{$catname}} )
{
$ctx->{currentSources}->{$data->{ALIAS}}->{CATALOGS}->{$catname}->{$key} = $data->{CATALOGS}->{$catname}->{$key};
}
}
return;
}
sub copyService
{
my $dst = shift || undef;
my $src = shift || undef;
$dst->{TYPE} = $src->{TYPE} if(exists $src->{TYPE});
$dst->{URL} = $src->{URL} if(exists $src->{URL});
$dst->{REGCODE} = $src->{REGCODE} if(exists $src->{REGCODE});
$dst->{ALIAS} = $src->{ALIAS} if(exists $src->{ALIAS});
if(exists $src->{CATALOGS} && ref($src->{CATALOGS}) eq "HASH")
{
foreach my $c (keys %{$src->{CATALOGS}})
{
if(ref($src->{CATALOGS}->{$c}) eq "HASH")
{
foreach my $hw (keys %{$src->{CATALOGS}->{$c}})
{
$dst->{CATALOGS}->{$c}->{$hw} = $src->{CATALOGS}->{$c}->{$hw};
}
}
else
{
$dst->{CATALOGS}->{$c} = $src->{CATALOGS}->{$c};
}
}
}
}
sub copyCatalog
{
my $dst = shift || undef;
my $src = shift || undef;
foreach my $key (keys %{$src})
{
$dst->{$key} = $src->{$key};
}
}
sub zyppServiceAdd
{
my $ctx = shift;
my $url = shift || undef;
my $type = shift || undef;
my $id = shift || undef;
my $msg = "";
my $code = 0;
$ctx->{timeindent}++;
my $t0 = [gettimeofday] if($ctx->{time});
printLog($ctx, "info", indent($ctx)."START: zyppServiceAdd") if($ctx->{time});
if (! defined $url || $url eq "")
{
return logPrintReturn($ctx, "Missing URL.\n", 14);
}
if (! defined $type || (lc($type) ne "yum" && lc($type) ne "zypp" && lc($type) ne "nu"))
{
return logPrintReturn($ctx, "Invalid type", 14);
}
# do not ask questions, especialy not to accept keys.
# The source is only added to the repo. The questions
# were asked at the first time this source is used.
my @zypperArgs = ("--no-refresh", "--quiet", "--non-interactive");
if(lc($type) eq "yum" || lc($type) eq "zypp")
{
#
# FIXME: we may be able to drop this late. addservice should be able to
# add also repos of type rpm-md and yast2
#
push @zypperArgs, "addrepo";
}
else
{
push @zypperArgs, "addservice";
}
#
# for type nu we know, that we need credentials
#
# if other types need authentication with the NCCcredentials
# the registration server should send a URL with query parameter:
#
# ?credentials=NCCcredentials
#
if(lc($type) eq "nu")
{
#
# NU type requires authentication
#
push @zypperArgs, urlAddCredentials($ctx, $url);
}
else
{
push @zypperArgs, "$url";
}
if(defined $id)
{
push @zypperArgs, $id;
}
else
{
# zypper requires a alias name. Use the url as fallback
push @zypperArgs, $url;
}
my $err = "";
($code, $err, $msg) = executeCommand($ctx, $ctx->{zypper}, undef, @zypperArgs);
if($code != 0)
{
$code += 30;
$msg .= "\n$err";
}
else
{
$msg = "";
}
printLog($ctx, "debug1", "Add service failed($code): $msg") if($code != 0);
printLog($ctx, "info", indent($ctx)."END: zyppServiceAdd:".(tv_interval($t0))) if($ctx->{time});
$ctx->{timeindent}--;
# return $code, but maybe it is ignored
return logPrintReturn($ctx, $msg, $code);
}
sub zyppServiceDelete
{
my $ctx = shift;
my $id = shift || undef;
my $type = shift || undef;
my $msg = "";
my $code = 0;
$ctx->{timeindent}++;
my $t0 = [gettimeofday] if($ctx->{time});
printLog($ctx, "info", indent($ctx)."START: zyppServiceDelete") if($ctx->{time});
if (! defined $type || (lc($type) ne "yum" && lc($type) ne "zypp" && lc($type) ne "nu"))
{
return logPrintReturn($ctx, "Invalid type", 14);
}
if(!defined $id)
{
return logPrintReturn($ctx, "Missing Identifirer", 14);
}
# we want to delete a source. All questions are useless here.
my @zypperArgs = ("--no-refresh", "--quiet", "--non-interactive");
if(lc($type) eq "yum" || lc($type) eq "zypp")
{
push @zypperArgs, "removerepo";
}
else
{
push @zypperArgs, "removeservice";
}
push @zypperArgs, "--loose-auth", "--loose-query";
push @zypperArgs, "$id";
my $err = "";
($code, $err, $msg) = executeCommand($ctx, $ctx->{zypper}, undef, @zypperArgs);
if($code != 0)
{
$code += 30;
$msg .= "\n$err";
}
else
{
$msg = "";
}
printLog($ctx, "debug1", "Delete service failed($code): $msg") if($code != 0);
printLog($ctx, "info", indent($ctx)."END: zyppServiceDelete:".(tv_interval($t0))) if($ctx->{time});
$ctx->{timeindent}--;
return logPrintReturn($ctx, $msg, $code);
}
sub zyppCatalogEnable
{
my $ctx = shift;
my $service = shift || undef;
my $catalog = shift || undef;
my $msg = "";
my $code = 0;
$ctx->{timeindent}++;
my $t0 = [gettimeofday] if($ctx->{time});
printLog($ctx, "info", indent($ctx)."START: zyppCatalogAdd") if($ctx->{time});
if (!defined $service || !defined $catalog)
{
return logPrintReturn($ctx, "No catalogs to subscribe\n", 14);
}
my @zypperArgs = ("--no-refresh", "--quiet", "--non-interactive", "modifyservice");
push @zypperArgs, "--ar-to-enable";
push @zypperArgs, "$catalog->{ALIAS}";
push @zypperArgs, "$service";
my $err = "";
($code, $err, $msg) = executeCommand($ctx, $ctx->{zypper}, undef, @zypperArgs);
if($code != 0)
{
$code += 30;
$msg .= "\n$err";
}
$msg =~ s/^\s*//;
$msg =~ s/\s*$//;
printLog($ctx, "debug1", "Errors during enable repo($code): $msg") if($code != 0);
printLog($ctx, "info", indent($ctx)."END: zyppCatalogAdd:".(tv_interval($t0))) if($ctx->{time});
$ctx->{timeindent}--;
return logPrintReturn($ctx, $msg, $code);
}
sub zyppCatalogDisable
{
my $ctx = shift;
my $service = shift || undef;
my $catalog = shift || undef;
my $msg = "";
my $code = 0;
$ctx->{timeindent}++;
my $t0 = [gettimeofday] if($ctx->{time});
printLog($ctx, "info", indent($ctx)."START: zyppCatalogDelete") if($ctx->{time});
if (!defined $service || !defined $catalog)
{
return logPrintReturn($ctx, "No catalogs to disable\n", 14);
}
my @zypperArgs = ("--no-refresh", "--quiet", "--non-interactive", "modifyservice");
push @zypperArgs, "--ar-to-disable";
push @zypperArgs, "$catalog->{ALIAS}";
push @zypperArgs, "$service";
my $err = "";
($code, $err, $msg) = executeCommand($ctx, $ctx->{zypper}, undef, @zypperArgs);
if($code != 0)
{
$code += 30;
$msg .= "\n$err";
}
$msg =~ s/^\s*//;
$msg =~ s/\s*$//;
printLog($ctx, "debug1", "Errors during disable repo($code): $msg") if($code != 0);
printLog($ctx, "info", indent($ctx)."END: zyppCatalogDelete:".(tv_interval($t0))) if($ctx->{time});
$ctx->{timeindent}--;
# ignore errors: Very often it is "unknown catalog".
# We want to unsubscribe a catalog which is not available => well, no problem.
logPrintReturn($ctx, $msg." Ignored", $code);
return (0, "");
}
sub zyppRefresh
{
my $ctx = shift;
my $code = 0;
my $msg = "";
$ctx->{timeindent}++;
my $t0 = [gettimeofday] if($ctx->{time});
printLog($ctx, "info", indent($ctx)."START: zyppRefresh") if($ctx->{time});
#
# refresh all services and repos
#
my @zypperArgs = ();
if(!$ctx->{interactive})
{
push @zypperArgs, "--non-interactive";
}
push @zypperArgs, "ref", "--service";
if($ctx->{interactive})
{
my $cmd = $ctx->{zypper}." ".join(' ', @zypperArgs);
printLog($ctx, "debug1", "Execute Command: $cmd");
`$cmd 1>&2`;
$code = ($?>>8);
}
else
{
my $err = "";
($code, $err, $msg) = executeCommand($ctx, $ctx->{zypper}, undef, @zypperArgs);
if($code != 0)
{
$code += 30;
$msg .= "\n$err";
}
}
printLog($ctx, "debug1", "Refresh failed($code): $msg") if($code != 0);
printLog($ctx, "info", indent($ctx)."END: zyppRefresh:".(tv_interval($t0))) if($ctx->{time});
$ctx->{timeindent}--;
return logPrintReturn($ctx, $msg, $code);
}
sub zypperOSTarget
{
my $ctx = shift;
my $err = "";
my $ostarget = "";
my $code = 1;
$ctx->{timeindent}++;
my $t0 = [gettimeofday] if($ctx->{time});
printLog($ctx, "info", indent($ctx)."START: zypperOSTarget") if($ctx->{time});
# do not set --quiet. This will result in no output
my @cmdArgs = ("--non-interactive", "targetos");
($code, $err, $ostarget) = executeCommand($ctx, $ctx->{zypper}, undef, @cmdArgs);
$code = $?;
if($code != 0)
{
$err = "Cannot get the os target. $err";
}
$ctx->{ostarget} = $ostarget;
printLog($ctx, "info", indent($ctx)."END: zypperOSTarget:".(tv_interval($t0))) if($ctx->{time});
$ctx->{timeindent}--;
return ($code, $err);
}
sub initGUID
{
my $ctx = shift;
$ctx->{timeindent}++;
my $t0 = [gettimeofday] if($ctx->{time});
printLog($ctx, "info", indent($ctx)."START: initGUID") if($ctx->{time});
my $fullpath = $ctx->{CREDENTIAL_DIR}."/".$ctx->{CREDENTIAL_FILE};
if(!-d "$ctx->{CREDENTIAL_DIR}")
{
mkdir "$ctx->{CREDENTIAL_DIR}" or return logPrintReturn($ctx, "Cannot create directory $ctx->{CREDENTIAL_DIR}: $!\n", 12);
}
#
# convert old deviceid/secret file into new format if the new file do not exist
# We do not remove deviceid/secret because zmd is available in other products
# and still use these files.
#
if(-e $ctx->{GUID_FILE} && -e $ctx->{SECRET_FILE} && !-e "$fullpath")
{
printLog($ctx, "info", "Converting credentials into the new format.");
# found old GUID/SECRET file. Convert them into the new format
open(ZMD, "< $ctx->{GUID_FILE}") or do
{
return logPrintReturn($ctx, "Cannot open file $ctx->{GUID_FILE}: $!\n", 12);
};
$ctx->{guid} = <ZMD>;
chomp($ctx->{guid});
close ZMD;
open(ZMD, "< $ctx->{SECRET_FILE}") or do
{
return logPrintReturn($ctx, "Cannot open file $ctx->{SECRET_FILE}: $!\n", 12);
};
$ctx->{secret} = <ZMD>;
chomp($ctx->{secret});
close ZMD;
open(CRED, "> $fullpath") or do {
return logPrintReturn($ctx, "Cannot open file fullpath for write: $!\n", 12);
};
print CRED "username=".$ctx->{guid}."\n";
print CRED "password=".$ctx->{secret}."\n";
close CRED;
my $mode = 0600;
chmod $mode, "$fullpath";
printLog($ctx, "debug1", "Credential file created: $ctx->{guid}");
printLog($ctx, "info", indent($ctx)."END: initGUID:".(tv_interval($t0))) if($ctx->{time});
$ctx->{timeindent}--;
return (0, "");
}
#
# if NCCcredentials file do not exist, create it
#
if(!-e "$fullpath")
{
printLog($ctx, "debug1", "Generating new credentials.");
my $guid = `$ctx->{createGuid} 2>/dev/null`;
if(!defined $guid || $guid eq "")
{
return logPrintReturn($ctx, "Cannot create guid. Command '$ctx->{createGuid}' failed.", 13);
}
chomp $guid;
$guid =~ s/-//g; # remove the -
$ctx->{guid} = $guid;
sleep(1);
my $secret = `$ctx->{createGuid} 2>/dev/null`;
if(!defined $secret || $secret eq "")
{
return logPrintReturn($ctx, "Cannot create secret. Command '$ctx->{createGuid}' failed.", 13);
}
chomp $secret;
$secret =~ s/-//g; # remove the -
$ctx->{secret} = $secret;
open(CRED, "> $fullpath") or do {
return logPrintReturn($ctx, "Cannot open file $fullpath for write: $!\n", 12);
};
print CRED "username=$guid\n";
print CRED "password=$secret\n";
close CRED;
my $mode = 0600;
chmod $mode, "$fullpath";
printLog($ctx, "debug1", "Credential file created: $ctx->{guid}");
printLog($ctx, "info", indent($ctx)."END: initGUID:".(tv_interval($t0))) if($ctx->{time});
$ctx->{timeindent}--;
return (0, "");
}
#
# read credentials from NCCcredentials file
#
open(CRED, "< $fullpath") or do {
return logPrintReturn($ctx, "Cannot open file $fullpath for read: $!\n", 12);
};
while(<CRED>)
{
if($_ =~ /username\s*=\s*(.*)$/ && defined $1 && $1 ne "")
{
$ctx->{guid} = $1;
}
elsif($_ =~ /password\s*=\s*(.*)$/ && defined $1 && $1 ne "")
{
$ctx->{secret} = $1;
}
}
close CRED;
printLog($ctx, "info", indent($ctx)."END: initGUID:".(tv_interval($t0))) if($ctx->{time});
$ctx->{timeindent}--;
return (0, "");
}
sub indent
{
my $ctx = shift;
my $ind = "";
for(my $i = 0;
$i < $ctx->{timeindent};
$i++)
{
$ind .= " ";
}
return $ind;
}
sub stripURL
{
my $ctx = shift;
my $url = shift || "";
if($url eq "")
{
return "";
}
my $uri = URI->new($url);
if($uri->scheme eq "http" ||
$uri->scheme eq "https" )
{
# delete user/password from url
$uri->userinfo(undef);
}
# delete all query parameter from the url
$uri->query(undef);
return $uri->as_string;
}
sub urlAddCredentials
{
my $ctx = shift;
my $url = shift || "";
if($url eq "")
{
return "";
}
my $uri = URI->new($url);
if($uri->scheme eq "http" ||
$uri->scheme eq "https" )
{
my %qp = $uri->query_form();
$qp{credentials} = $ctx->{CREDENTIAL_FILE};
$uri->query_form(%qp);
}
return $uri->as_string;
}
sub executeCommand
{
my $ctx = shift;
my $command = shift;
my $input = shift;
my @arguments = @_;
my $out = "";
my $err = "";
my $code = 0;
my $lang = $ENV{LANG}||"";
my $language = $ENV{LANGUAGE}||"";
$lang = undef if($lang =~ /^en_/);
$language = undef if($language =~ /^en_/);
if(!defined $command || !-x $command)
{
return logPrintReturn($ctx, "invalid Command '$command'", 13)
}
# set lang to en_US to get output in english.
$ENV{LANG} = "en_US" if(defined $lang);
$ENV{LANGUAGE} = "en_US" if(defined $language);
printLog($ctx, "debug1", "Execute command: $command ".join(" ",@arguments));
my $pid = open3(\*IN, \*OUT, \*ERR, $command, @arguments) or do {
$ENV{LANG} = $lang if(defined $lang);
$ENV{LANGUAGE} = $language if(defined $language);
return logPrintReturn($ctx, "Cannot execute $command ".join(" ", @arguments).": $!\n",13);
};
if(defined $input)
{
print IN $input;
}
close IN;
while (<OUT>)
{
$out .= "$_";
}
while (<ERR>)
{
$err .= "$_";
}
close OUT;
close ERR;
waitpid $pid, 0;
chomp($out);
chomp($err);
$ENV{LANG} = $lang if(defined $lang);
$ENV{LANGUAGE} = $language if(defined $language);
$code = ($?>>8);
printLog($ctx, "debug1", "Execute command exit($code): $err");
printLog($ctx, "debug3", "Execute command result: $out") if(defined $out && $out ne "");
return ($code, $err, $out);
}
sub detectVirtualization
{
my $ctx = shift;
my $code = 1;
my $err = "";
my $val = "";
if(-d "/proc/xen")
{
printLog($ctx, "debug2", "Found XEN");
if(-e "/proc/xen/xsd_port")
{
printLog($ctx, "debug2", "We are Domain-0");
my $xend_running=0;
($code, $err, $val) = executeCommand($ctx, "/etc/init.d/xend", undef, ("status"));
if($code == 0)
{
$xend_running = 1;
}
# we are Domain-0 ; xenstored is required in domain 0 for xenstore-write...
if($xend_running && -e $ctx->{xenstorewrite} && -e $ctx->{xenstorechmod})
{
printLog($ctx, "debug1", "Write /tool/SR/HostDeviceID to xenbus");
executeCommand($ctx, $ctx->{xenstorewrite}, undef, ("/tool/SR/HostDeviceID", "$ctx->{guid}"));
executeCommand($ctx, $ctx->{xenstorechmod}, undef, ("/tool/SR/HostDeviceID", "r"));
}
}
else
{
$ctx->{virtType} = "Xen";
$ctx->{hostGUID} = "Y";
if(-e $ctx->{xenstoreread})
{
printLog($ctx, "debug2", "try to read /tool/SR/HostDeviceID from xenbus");
($code, $err, $val) = executeCommand($ctx, $ctx->{xenstoreread}, undef, ("/tool/SR/HostDeviceID"));
if(defined $val && $val ne "")
{
printLog($ctx, "debug2", "Got /tool/SR/HostDeviceID: $val");
$ctx->{hostGUID} = $val;
}
}
}
}
else
{
my ($code, $err, $out) = executeCommand($ctx, $ctx->{lscpu}, undef);
if($code != 0)
{
printLog($ctx, "warn", "Cannot execute lscpu: $code $err");
}
else
{
foreach my $line (split(/\n/, $out))
{
if($line =~ /^Hypervisor vendor:\s*(.*)\s*$/ && defined $1)
{
$ctx->{virtType} = "$1";
$ctx->{hostGUID} = "Y";
last;
}
}
}
if(!defined $ctx->{virtType} || $ctx->{virtType} eq "")
{
# search for fallback.
if(defined $ctx->{FallbackHostGUID} && $ctx->{FallbackHostGUID} ne "")
{
$ctx->{virtType} = "suseRegister.conf";
$ctx->{hostGUID} = $ctx->{FallbackHostGUID};
}
}
}
return (0, "");
}
#
# FIXME: old curl variant. Remove this function if the new one works.
#
sub sendDataCurl
{
my $ctx = shift;
my $url = shift || undef;
my $data = shift || undef;
$ctx->{timeindent}++;
my $t0 = [gettimeofday] if($ctx->{time});
printLog($ctx, "info", indent($ctx)."START: sendData") if($ctx->{time});
my $curlErr = 0;
my $res = "";
my $err = "";
my %header = ();
my $code = "";
my $mess = "";
if (! defined $url)
{
logPrintError($ctx, "Cannot send data to registration server. Missing URL.\n", 14);
return;
}
if($url =~ /^-/)
{
logPrintError($ctx, "Invalid protocol($url).\n", 15);
return;
}
my $uri = URI->new($url);
if(!defined $uri->host || $uri->host !~ /$ctx->{initialDomain}$/)
{
logPrintError($ctx, "Invalid URL($url). Data could only be send to $ctx->{initialDomain} .\n", 15);
return;
}
if(!defined $uri->scheme || $uri->scheme ne "https")
{
logPrintError($ctx, "Invalid protocol($url). https is required.\n", 15);
return;
}
$url = $uri->as_string;
if (! defined $data)
{
logPrintError($ctx, "Cannot send data. Missing data.\n", 14);
return;
}
my @cmdArgs = ( "--capath", $ctx->{CA_PATH});
my $fh = new File::Temp(TEMPLATE => 'dataXXXXX',
SUFFIX => '.xml',
DIR => '/tmp/');
print $fh $data;
push @cmdArgs, "--data", "@".$fh->filename();
push @cmdArgs, "-i";
push @cmdArgs, "--max-time", "130";
foreach my $extraOpt (@{$ctx->{extraCurlOption}})
{
if($extraOpt =~ /^([\w-]+)[\s=]*(.*)/)
{
if(defined $1 && $1 ne "")
{
push @cmdArgs, $1;
if(defined $2 && $2 ne "")
{
push @cmdArgs, $2;
}
}
}
}
push @cmdArgs, "$url";
printLog($ctx, "debug2", "Call $ctx->{curl} ".join(" ", @cmdArgs));
printLog($ctx, "debug2", "SEND DATA to URI: $url:");
printLog($ctx, "debug2", "$data");
printLog($ctx, "info", "\nSEND DATA to URI: $url:", 0, 1);
printLog($ctx, "info", "$data", 0, 1);
if($ctx->{noproxy})
{
delete $ENV{'http_proxy'};
delete $ENV{'HTTP_PROXY'};
delete $ENV{'https_proxy'};
delete $ENV{'HTTPS_PROXY'};
delete $ENV{'ALL_PROXY'};
delete $ENV{'all_proxy'};
}
$ENV{'PATH'} = '/bin:/usr/bin:/sbin:/usr/sbin:/opt/kde3/bin/:/opt/gnome/bin/';
my $pid = open3(\*IN, \*OUT, \*ERR, $ctx->{curl}, @cmdArgs) or do {
logPrintError($ctx, "Cannot execute $ctx->{curl} ".join(" ", @cmdArgs).": $!\n",13);
return;
};
my $foundBody = 0;
while (<OUT>)
{
$res = "" if(! defined $res);
if ($foundBody)
{
$res .= "$_";
}
elsif ($_ =~ /^HTTP\/\d\.\d\s(\d+)\s(.*)$/)
{
if (defined $1 && $1 ne "")
{
$code = $1;
}
if (defined $2 && $2 ne "")
{
$mess = $2;
}
}
elsif ($_ =~ /^[\w-]+:\s/)
{
my ($key, $val) = split(/: /, $_, 2);
$header{$key} = $val;
}
elsif ($_ =~ /^\s*</)
{
$foundBody = 1;
$res .= "$_";
}
}
while (<ERR>)
{
$err .= "$_";
}
close OUT;
close ERR;
close IN;
waitpid $pid, 0;
$curlErr = ($?>>8);
printLog($ctx, "debug2", "CURL RETURN WITH: $curlErr");
printLog($ctx, "debug2", "RECEIVED DATA:");
printLog($ctx, "debug2", "CODE: $code MESSAGE: $mess");
printLog($ctx, "debug2", "HEADER: ".Data::Dumper->Dump([\%header]));
printLog($ctx, "debug2", "BODY: $res");
printLog($ctx, "info", "RECEIVED DATA:",0,1);
printLog($ctx, "info", "CURL RETURN WITH: $curlErr",0,1);
printLog($ctx, "info", "CODE: $code MESSAGE: $mess",0,1);
printLog($ctx, "info", "HEADER: ".Data::Dumper->Dump([\%header]),0,1);
printLog($ctx, "info", "BODY: $res",0,1);
if ($curlErr != 0)
{
logPrintError($ctx, "Execute curl command failed with '$curlErr': $err", 4);
return $res;
}
if ($code >= 300 && exists $header{Location} && defined $header{Location})
{
if ($ctx->{redirects} > 5)
{
logPrintError($ctx, "Too many redirects. Aborting.\n", 5);
return $res;
}
$ctx->{redirects}++;
my $loc = $header{Location};
local $/ = "\r\n";
chomp($loc);
local $/ = "\n";
#print STDERR "sendData(redirect): ".(tv_interval($t0))."\n" if($ctx->{time});
$res = sendData($ctx, $loc, $data);
}
elsif($code < 200 || $code >= 300)
{
my $b = "";
my @c = ();
if(-e "/usr/bin/lynx")
{
$b = "/usr/bin/lynx";
push @c, "-dump", "-stdin";
}
elsif(-e "/usr/bin/w3m")
{
$b = "/usr/bin/w3m";
push @c, "-dump", "-T", "text/html";
}
my $out = "";
if(-x $b)
{
my $pid = open3(\*IN, \*OUT, \*ERR, $b, @c) or do
{
logPrintError($ctx, "Cannot execute $b ".join(" ", @c).": $!\n",13);
return undef;
};
print IN $res;
close IN;
while (<OUT>)
{
$out .= "$_";
}
#chomp($msg) if(defined $msg && $msg ne "");
while (<ERR>)
{
$out .= "$_";
}
close OUT;
close ERR;
waitpid $pid, 0;
chomp($out) if(defined $out && $out ne "");
$out .="\n";
}
$out .= "$mess\n";
logPrintError($ctx, "ERROR: $code: $out\n", 2);
}
printLog($ctx, "info", indent($ctx)."END: sendData:".(tv_interval($t0))) if($ctx->{time});
$ctx->{timeindent}--;
return $res;
}
1;
ACC SHELL 2018