diff options
Diffstat (limited to 'mdkonline.pm')
| -rw-r--r-- | mdkonline.pm | 388 |
1 files changed, 0 insertions, 388 deletions
diff --git a/mdkonline.pm b/mdkonline.pm index f31a8c70..1053f034 100644 --- a/mdkonline.pm +++ b/mdkonline.pm @@ -24,62 +24,13 @@ package mdkonline; use strict; -use MIME::Base64 qw(encode_base64); use lib qw(/usr/lib/libDrakX); -use c; use common; -use LWP::UserAgent; -use Net::HTTPS; -use HTTP::Request::Common; -use HTTP::Request; -use SOAP::Lite; use log; -#For debugging -use Data::Dumper; - -my ($service_proxy); - -my $testing = 1; - my $release_file = find { -f $_ } '/etc/mandriva-release', '/etc/mandrakelinux-release', '/etc/mandrake-release', '/etc/redhat-release'; -my ($product_file, $conf_file, $rootconf_file) = ('/etc/sysconfig/system', '/etc/sysconfig/mdkonline', '/root/.MdkOnline/hostconf'); - -my $uri = !$testing ? 'https://online.mandriva.com/soap' : 'https://online3.mandriva.com/soap/'; - -my $online_proxy = $service_proxy = $uri; - -my $useragent = set_ua('mdkonline'); - -sub is_proxy () { - return defined $ENV{http_proxy} ? 1 : defined $ENV{https_proxy} ? 2 : 0; -} - -my $proxy = is_proxy(); - -my $s = $proxy == 2 - ? SOAP::Lite->uri($uri)->proxy($service_proxy, proxy => [ 'http' => $ENV{https_proxy} ], agent => $useragent) - : $proxy == 1 - ? SOAP::Lite->uri($uri)->proxy($service_proxy, proxy => [ 'http' => $ENV{http_proxy} ], agent => $useragent) - : SOAP::Lite->uri($uri)->proxy($service_proxy, agent => $useragent); - -sub upgrade2v3() { - my $res; - if (-e $rootconf_file) { - my %oc = getVarsFromSh($rootconf_file); - my $res = soap_recover_service($oc{LOGIN}, '{md5}' . $oc{PASS}, $oc{MACHINE}, $oc{COUNTRY}); - print Data::Dumper->Dump([ $res ], [qw(res)]); - $res = check_server_response($res); - } - $res; -} - -sub get_rpmdblist() { - my $rpmdblist = `rpm -qa --queryformat '%{HDRID};%{N};%{E};%{V};%{R};%{ARCH};%{OS};%{DISTRIBUTION};%{VENDOR};%{SIZE};%{BUILDTIME};%{INSTALLTIME}\n'`; - $rpmdblist; -} sub md5file { require Digest::MD5; @@ -100,277 +51,11 @@ sub get_release() { ($r); } -sub set_ua { - my $package_name = shift; - my $qualified_name = chomp_(`rpm -q $package_name`); - $qualified_name; -} - -sub get_distro_type() { - my $r = cat_($release_file); - my ($archi) = $r =~ /\s+for\s+(\w+)/; - my ($name) = $r =~ /(corporate|mnf)/i; - { name => lc($name), 'arch' => $archi }; -} - -sub soap_create_account { - my $data = $s->registerUser(@_)->result; - log::explanations("creating account $_[0]"); - $data; -} - -sub soap_authenticate_user { - my $data = $s->authenticateUser(@_)->result; - log::explanations("authenticating account $_[0]"); - $data; -} - -sub soap_register_host { - my $data = $s->registerHost(@_)->result; - log::explanations("registering host $_[3] named $_[4] in country $_[5]"); - $data; -} - -sub soap_upload_config { - my $data = $s->setHostConfig(@_); - log::explanations("uploading config for host id $_[0] host key $_[1] class $_[2]"); - $data ? $data->result : undef; -} - -sub soap_query_bundle { - my ($wc, $bundle_name) = @_; - log::explanations("querying the bundle $bundle_name"); - my $data = $s->query($wc->{HOST_ID}, $wc->{HOST_KEY}, 'Software::get_bundle', $bundle_name)->result; - $data; -} -sub register_upload_host { - my ($login, $password, $boxname, $descboxname, $country) = @_; - my ($registered, $res); - my $wc = read_conf(); - if (!$wc->{HOST_ID} && -e $rootconf_file) { - $res = upgrade2v3(); - } elsif (!$wc->{HOST_ID} && !-e $rootconf_file) { - $registered = soap_register_host($login, $password, $boxname, $descboxname, $country); - print Data::Dumper->Dump([ $registered ], [qw(registered)]); - $res = check_server_response($registered); - } - return $res if defined $res && $res ne 'OK'; - #Reread configuration - $wc = read_conf() if $res eq 'OK'; - $res = prepare_upload_conf($wc); - $res; -} - -sub prepare_upload_conf { - my ($wc) = shift; - my ($uploaded, $res); - my $r = cat_($release_file); - my %p = getVarsFromSh($product_file); - my $rpmdblist = get_rpmdblist(); - $wc->{HOST_ID} and $uploaded = soap_upload_config($wc->{HOST_ID}, $wc->{HOST_KEY}, $r, $p{META_CLASS}, $rpmdblist); - $res = check_server_response($uploaded); - return $res; -} - -sub get_from_URL { - my ($link, $agent_name) = @_; - my $ua = LWP::UserAgent->new; - $ua->agent($agent_name . $useragent); - $ua->env_proxy; - my $request = HTTP::Request->new(GET => $link); - my $response = $ua->request($request); - $response; -} - -sub get_site { - my $link = shift; - $link .= join('', @_); - system("/usr/bin/www-browser " . $link . "&"); -} - -sub create_authenticate_account { - my $type = shift; - my @info = @_; - my ($response, $ret); - my $action = { - create => sub { eval { $response = soap_create_account(@info) } }, - authenticate => sub { eval { $response = soap_authenticate_user(@info) } } - }; - $action->{$type}->(); - $ret = check_server_response($response); - $ret; -} - -sub check_server_response { - my ($response) = shift; - my $hash_ret = { - 1 => [ N_("Security error"), N("Generic error (machine already registered)") ], - 2 => [ N("Database error"), N("Server Database failed\nPlease Try again Later") ], - 3 => [ N("Registration error"), N("Some parameters are missing") ], - 5 => [ N("Password error"), N("Wrong password") ], - 7 => [ N("Login error"), N("The email you provided is already in use\nPlease enter another one\n") ], - 8 => [ N("Login error"), N("The email you provided is invalid or forbidden") ], - 10 => [ N("Login error"), N("Email address box is empty\nPlease provide one") ], - 12 => [ N("Restriction Error"), N("Database access forbidden") ], - 13 => [ N("Service error"), N("Mandriva web services are currently unavailable\nPlease Try again Later") ], - 17 => [ N("Password error"), N("Password mismatch") ], - 20 => [ N("Service error"), N("Mandriva web services are under maintenance\nPlease Try again Later") ], - 22 => [ N("User Forbidden"), N("User account forbidden by Mandriva web services") ], - 99 => [ N("Connection error"), N("Mandriva web services not reachable") ] - }; - foreach my $num ([9, 8], [21, 20]) { $hash_ret->{$num->[0]} = $hash_ret->{$num->[1]} } - # print Data::Dumper->Dump([ $response ], [qw(response)]); - my $code = $response->{code} || '99'; - my $answer = $response->{code} eq 0 ? 'OK' : $hash_ret->{$code} ? $hash_ret->{$code}[0] . ' : ' . $hash_ret->{$code}[1] . "\n\n" . $response->{message} : $response->{message}; - $answer eq 'OK' and write_conf($response) if !$<; - log::explanations(qq(the server returned "$answer")); - return $answer; - -} - -sub check_valid_email { - my $email = shift; - my $st = $email =~ /^[a-z][a-z0-9_\-]*(\.[a-z][a-z0-9_]+)?@([a-z][a-z0-9_\-]+\.){1,3}(\w{2,4})(\.[a-z]{2})?$/ix ? 1 : 0; - return $st; -} - -sub check_valid_boxname { - my $boxname = shift; - return 0 if length($boxname) >= 40; - my $bt = $boxname =~ /^[a-zA-Z][a-zA-Z0-9_.]+$/i ? 1 : 0; - $bt; -} - -sub rpm_ver_parse { - my ($ver) = @_; - my @verparts; - while ($ver ne "") { - if ($ver =~ /^([A-Za-z]+)/) { # leading letters - push(@verparts, $1); - $ver =~ s/^[A-Za-z]+//; - } elsif ($ver =~ /^(\d+)/) { # leading digits - push(@verparts, $1); - $ver =~ s/^\d+//; - } else { # remove non-letter, non-digit - $ver =~ s/^.//; - } - } - return @verparts; -} - -sub rpm_ver_cmp { - my ($a, $b) = @_; - # list of version/release tokens - my @aparts; - my @bparts; - # individual token from array - my ($apart, $bpart, $result); - if ($a eq $b) { - return 0; - } - @aparts = rpm_ver_parse($a); - @bparts = rpm_ver_parse($b); - while (@aparts && @bparts) { - $apart = shift (@aparts); - $bpart = shift (@bparts); - if ($apart =~ /^\d+$/ && $bpart =~ /^\d+$/) { # numeric - if ($result = $apart <=> $bpart) { - return $result; - } - } elsif ($apart =~ /^[A-Za-z]+/ && $bpart =~ /^[A-Za-z]+/) { # alpha - if ($result = $apart cmp $bpart) { - return $result; - } - } else { # "arbitrary" in original code - my $rema = shift(@aparts); - my $remb = shift(@bparts); - if ($rema && !$remb) { return 1 } elsif (!$rema && $remb) { return -1 } - #return -1; - } - } - # left over stuff in a or b, assume one of the two is newer - if (@aparts) { return 1 } elsif (@bparts) { return -1 } else { return 0 } -} - -sub soap_recover_service { - my $data = $s->recoverHostFromV2(@_)->result; - $data; -} - -sub soap_get_task { - my $data = $s->getTask(@_)->result; - $data; -} - -sub soap_return_task_result { - my $data = $s->setTaskResult(@_)->result; - $data; -} - -sub soap_get_updates_for_host { - my $data = $s->getUpdatesForHost(@_)->result; - $data; -} - -sub soap_is_new_update_for_distro { - my $data = $s->isNewUpdateForDistribution(@_)->result; - $data; -} - -sub mv_files { - my ($source, $dest) = @_; - -e $source and system("mv", $source, $dest); -} - sub clean_confdir() { my $confdir = '/root/.MdkOnline'; system "/bin/rm", "-f", "$confdir/*log.bz2", "$confdir/*log.bz2.uue", "$confdir/*.dif $confdir/rpm_qa_installed_before", "$confdir/rpm_qa_installed_after"; } -sub hw_upload { - my ($login, $passwd, $hostname) = @_; - my $hw_exec = '/usr/sbin/hwdb_add_system'; - -x $hw_exec && !-s '/etc/sysconfig/mdkonline' and system("HWDB_PASSWD=$passwd $hw_exec $login $hostname &"); -} - -sub automated_upgrades() { - output_p "/etc/cron.daily/mdkupdate", - qq(#!/bin/bash -if [ -f $conf_file ]; then /usr/sbin/mdkupdate --auto; fi -); - chmod 0755, "/etc/cron.daily/mdkupdate"; -} - -sub read_conf() { - my %wc = getVarsFromSh($conf_file); - \%wc; -} - -sub write_conf { - my $response = shift; - write_wide_conf($response); -} - -sub get_date() { - my $date = `date --iso-8601=seconds`; # output date/time in ISO 8601 format. Ex: 2006-02-21T17:04:19+0100 - $date = chomp_($date); - $date; -} - -sub write_wide_conf { - my ($soap_response) = shift; - #print Data::Dumper->Dump([ $soap_response ], [qw(soap_response)]); - my $date = get_date(); my $conf_hash; - %$conf_hash = getVarsFromSh($conf_file); - $conf_hash->{uc($_)} = $soap_response->{data}{$_} foreach keys %{$soap_response->{data}}; - #print Data::Dumper->Dump([ $conf_hash ], [qw(conf_hash)]); - $conf_hash->{DATE_SET} = $date; - foreach my $alias (['email', 'user_email'], ['customer_id', 'user_id']) { - exists $conf_hash->{uc($alias->[0])} and $conf_hash->{uc($alias->[1])} = $conf_hash->{uc($alias->[0])}; - } - setVarsInSh($conf_file, $conf_hash, qw(USER_EMAIL USER_ID HOST_NAME HOST_ID HOST_KEY HOST_DESC HOST_MOBILE VERSION DATE_SET)); -} - sub is_running { my ($name) = @_; my $found; @@ -384,77 +69,4 @@ sub is_running { $found; } -# Romain: you need to finish those dns functions or drop them -sub get_configuration { - my $_in = shift; - my $config_file = '/etc/sysconfig/mdkonline'; - my %conf;my $ret; - # check local config file - if (! (-e $config_file) || ! (-s $config_file)) { - %conf = get_conf_from_dns(); - print "from dns:\n", Dumper(%conf), "\n"; - } else { - %conf = getVarsFromSh($config_file); - if (defined $conf{MACHINE} && !defined $conf{VERSION}) { - $ret = upgrade_to_v3(); - print "\n", $ret, "\n"; - if ($ret == 1) { - # reload config - %conf = getVarsFromSh($config_file); - } - else { - # TODO what do we do now? email warning? support? forget it? - %conf = undef; - } - } - } - - # now, a valid working config file is loaded - if (defined $conf{MOBILE} && $conf{MOBILE} eq 'TRUE') { - # client is mobile: we check for any dns-declared local option - # (like, a local update mirror) - # TODO set precedence rules. user may not want/have the right to - # follow local network rules (security of the update process). - # depends on host config, and on server commands. - my $sd = new Discovery; - my $info = $sd->search; - if ($info) { - # TODO - } - else {} # nothing to do - } - %conf; -} - -sub register_from_dns { - my $dnsconf = shift; - my ($hostinfo, $country ); - my $user = $dnsconf->{user}{name}; - my $pass = $dnsconf->{user}{pass}; - my $hostname = chomp_(`hostname`); - # TODO change SOAP proxy to the one indicated at $dnsconf->{service} before - # TODO wrap all soap calls into an object so we can update the proxy on the fly? - my $res = mdkonline::soap_register_host($user, $pass, $hostname, $hostinfo, $country); - if ($res->{code}) { - $res->{data}{service} = $dnsconf->{service}; - return mdkonline::save_config($res->{data}); - } -} - -sub get_conf_from_dns() { - my $sd = new Discover; - my $info = $sd->search; - my $ret; - if ($info) { - if (defined $info->{user}{name} && defined $info->{user}{pass} && $info->{user}{name} ne '' && $info->{user}{pass} ne '') { - #print Data::Dumper->Dump([ $info ], [qw(info)]); - # TODO check service certificate - $ret = mdkonline::register_from_dns($info); - if ($ret) { - return $ret; - } - } - } -} - 1; |