From 58739218a070ff6668beecf2b3b5e7173a663de9 Mon Sep 17 00:00:00 2001 From: Thierry Vignaud Date: Mon, 27 Feb 2006 14:58:12 +0000 Subject: perl_checker fixes --- .perl_checker | 3 + ChangeLog | 357 +++++++++++++++++++++++++++++++++++++++++++++++++++++ Discover.pm | 21 ++-- mdkapplet | 54 ++++---- mdkonline | 17 ++- mdkonline.pm | 78 ++++++------ mdvonline_agent.pl | 22 ++-- 7 files changed, 450 insertions(+), 102 deletions(-) diff --git a/.perl_checker b/.perl_checker index d6d5ff6d..a211fef0 100644 --- a/.perl_checker +++ b/.perl_checker @@ -2,6 +2,7 @@ AutoLoader Carp::Heavy constant Digest::base +Discover Encode File::Path Gtk2::Gdk::Keysyms @@ -16,5 +17,7 @@ Net::HTTP Net::HTTP::Methods Net::Ping Net::SSL +Scalar::Util SOAP::Lite +Switch urpm diff --git a/ChangeLog b/ChangeLog index 7651c2b8..640c07c0 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,360 @@ +2006-02-27 15:53 Daouda Lo + + * mdkonline.pm: - more perl_checker + +2006-02-27 15:49 Daouda Lo + + * mdkonline.pm: - perl_checko + +2006-02-27 15:29 Thierry Vignaud + + * mdkonline.pm: (check_valid_email) make it work + +2006-02-27 15:19 Thierry Vignaud + + * .perl_checker: blacklist a few more modules + +2006-02-24 18:26 Daouda Lo + + * mdkupdate: - add option for --update + +2006-02-23 21:08 Daouda Lo + + * mdkupdate: - install bundle with same code than --auto option + +2006-02-23 21:07 Daouda Lo + + * mdkonline.pm: - handle bundle + +2006-02-23 20:54 Daouda Lo + + * mdkupdate: - checking the correct way to do things + +2006-02-23 20:34 Daouda Lo + + * mdkupdate: - create media and install bundle + +2006-02-23 18:19 Daouda Lo + + * mdkupdate: - fix func name + +2006-02-23 17:27 Daouda Lo + + * mdkupdate: - remove unneeded vars + +2006-02-23 16:35 Daouda Lo + + * Makefile: - remove mdvbundle refs + +2006-02-23 16:34 Daouda Lo + + * mdkonline.pm: - put all soap call in mdkonline.pm + +2006-02-23 15:48 Daouda Lo + + * mdkupdate: - connect to start page + +2006-02-23 15:39 Daouda Lo + + * mdkupdate: - get_updates_for host + +2006-02-23 13:13 Daouda Lo + + * mdkupdate: - new soap API + +2006-02-23 11:24 Daouda Lo + + * mdkonline.pm: - add getUpdateHost func + +2006-02-23 11:06 Daouda Lo + + * mdkonline.pm: - make code more modular : separate prepare_upload + to use it in cron daemon exec + +2006-02-23 11:03 Daouda Lo + + * mdvbundle.pl: remove unneeded file + +2006-02-23 11:03 Daouda Lo + + * mdkupdate: - check bundle info + +2006-02-23 10:55 Daouda Lo + + * mdkonline.spec: - clean up + +2006-02-22 20:15 Daouda Lo + + * mdkonline: - fix typo + +2006-02-22 19:51 Daouda Lo + + * mdkonline: - keep unchanged values unchanged + +2006-02-22 19:51 Daouda Lo + + * mdkonline.pm: - load config before writing change. Keep unchanged + values unchanged + +2006-02-22 19:19 Daouda Lo + + * mdkonline.pm: - add better error message + +2006-02-22 19:06 Daouda Lo + + * mdkonline.pm: - fix readconf API - added alias to make mdkonline + more consistent + +2006-02-22 18:50 Daouda Lo + + * mdkonline.pm: - handle upgrade v2 to v3 case + +2006-02-22 18:50 Daouda Lo + + * mdkonline: - clean up + +2006-02-22 14:43 Daouda Lo + + * mdkonline: - sync + +2006-02-22 14:28 Daouda Lo + + * mdkonline.pm: - write conf + +2006-02-21 18:50 Daouda Lo + + * mdkonline: - save settings + +2006-02-21 18:49 Daouda Lo + + * mdkonline.pm: - save settings (to be finished) + +2006-02-21 13:35 Daouda Lo + + * mdkonline.pm: - write global conf + +2006-02-21 13:34 Daouda Lo + + * mdkonline: - no needed key anymore + +2006-02-21 13:16 Daouda Lo + + * mdkonline: - switch to new system + +2006-02-19 11:59 Pablo Saratxaga + + * po/el.po: updated po file + +2006-02-16 17:51 Daouda Lo + + * mdkonline.pm: - sync + +2006-02-16 17:50 Daouda Lo + + * mdkupdate: - if bundle is given without arg, connect to mdkonline + bundle webpage. + +2006-02-16 16:05 Daouda Lo + + * Makefile: - fcrozat fixes for mime-type association + +2006-02-16 16:04 Daouda Lo + + * mdkonline.spec: - big fcrozat help + +2006-02-16 15:54 Daouda Lo + + * mdkonline.xml: - mime meta-info for mdkonlien + +2006-02-15 19:07 Daouda Lo + + * mdkonline.spec: - add fake bin for mime type + +2006-02-15 19:06 Daouda Lo + + * Makefile: - add bundle + +2006-02-15 19:04 Daouda Lo + + * mdkupdate: - sync + +2006-02-15 19:03 Daouda Lo + + * mdvbundle.pl: - fix typo + +2006-02-15 17:53 Daouda Lo + + * mdkonline.pm: - sync + +2006-02-15 17:52 Daouda Lo + + * mdkonline.spec: - add mime to filelist + +2006-02-15 17:37 Daouda Lo + + * mdkonline.spec: - fix typo on mime filename + +2006-02-15 17:09 Daouda Lo + + * mdkapplet: - sync + +2006-02-15 17:09 Daouda Lo + + * mdkonline.spec: - change date + +2006-02-15 17:08 Daouda Lo + + * mdkonline.pm: - sync with new arch + +2006-02-15 17:07 Daouda Lo + + * mdkupdate: - use real machine name + +2006-02-15 16:33 Daouda Lo + + * mdkupdate: - added code to handle bundle + +2006-02-15 16:32 Daouda Lo + + * mdkonline: - fixed wizard mode + +2006-02-15 06:53 Shiva Huang + + * po/zh_TW.po: updated po file + +2006-02-14 16:28 Daouda Lo + + * mdkonline.spec: - mimetype association between bundle and + mdkupdate + +2006-02-10 18:09 Daouda Lo + + * mdkonline.spec: - Mandriva Online V3 - extra package installation + and update capabilities + +2006-02-09 12:15 Daouda Lo + + * mdkapplet: - change error to updates + +2006-02-09 11:50 Daouda Lo + + * mdkapplet: - add bundle support + +2006-02-08 18:28 Daouda Lo + + * pixmaps/bundle.png: new icon + +2006-02-08 15:25 berthy + + * po/fr.po: Update french translation + +2006-01-07 08:33 mmodem + + * po/pt.po: [no log message] + +2006-01-04 18:01 mmodem + + * po/pt.po: [no log message] + +2005-12-27 15:01 Daouda Lo + + * mdkupdate: - don't need to check multiple instance of mdkupdate + (the database is locked anyway by the first to get in) + +2005-12-27 13:09 Daouda Lo + + * mdkapplet: - grey Main Window before calling fork/exec + +2005-12-25 23:17 Daouda Lo + + * mdkapplet: - Fixed ugly freeze state when launching configure and + update process through applet + +2005-12-23 11:58 Сергій Рибалченко (Sergey Ribalchenko) + + * po/uk.po: uk tr-tion update + +2005-12-16 16:51 Romain d'Alverny + + * mdkonline.pm: Uploaded packages list is now formatted like a csv + file (;-separated) + +2005-12-14 14:43 Pablo Saratxaga + + * po/gl.po: updated po file + +2005-12-10 00:39 Thierry Vignaud + + * po/br.po: update + +2005-12-09 12:14 Romain d'Alverny + + * mdkonline.pm: [no log message] + +2005-12-09 11:14 Daouda Lo + + * mdkonline.spec: - display updates to install even if server is + out of sync - fully SOAP enabled + +2005-12-08 16:41 Romain d'Alverny + + * Discover.pm, mdkonline.pm, mdvonline_agent.pl: [no log message] + +2005-12-06 20:11 Romain d'Alverny + + * mdkonline.pm: Added upgrade_to_v3(), soap_recover_service(). + Updated soap_create_account(). + +2005-12-06 20:10 Romain d'Alverny + + * mdvonline_agent.pl: Online agent draft for service recovery (v2 + to v3) and dns discovery. + +2005-12-06 20:09 Romain d'Alverny + + * Discover.pm: DNS service discovery module for a Mandriva Online + client. + +2005-12-02 13:22 Daouda Lo + + * mdkupdate: - display update even if server is out of sync + +2005-12-02 13:19 Daouda Lo + + * mdkonline.pm: - make code more robust and more maintainable + +2005-11-26 08:32 Sharuzzaman Ahmat Raslan + + * po/ms.po: Updated Malay translation + +2005-11-23 18:18 Romain d'Alverny + + * TODO: [no log message] + +2005-11-16 13:34 Daouda Lo + + * TODO: - clean up - update + +2005-11-16 13:25 Daouda Lo + + * mdkonline.spec: - update TODO - Change fuzzy menu title + +2005-11-14 12:04 Sharuzzaman Ahmat Raslan + + * po/ms.po: Updated Malay translation + +2005-10-29 05:30 Sharuzzaman Ahmat Raslan + + * po/ms.po: Updated Malay translation + +2005-10-28 15:58 Pablo Saratxaga + + * po/bg.po: updated po file + +2005-10-27 19:08 Daouda Lo + + * ChangeLog: Generated by cvs2cl the 27_oct + 2005-10-24 02:46 Willy Sudiarto Raharjo * po/id.po: Updated Contact Info diff --git a/Discover.pm b/Discover.pm index 8b0e220c..e2dff77d 100644 --- a/Discover.pm +++ b/Discover.pm @@ -38,8 +38,7 @@ use Log::Agent; # use settings from main file my $VERSION = '0.01'; # -sub new -{ +sub new { my $self = {}; bless $self, "Discover"; logsay "DNS Service Discovery module $VERSION"; @@ -47,15 +46,14 @@ sub new } # -sub init -{ +sub init { my $this = shift; $this->{domainname} = ''; $this->{zone} = ''; $this->{service} = ''; $this->{nameserver} = ''; $this->{instance} = ''; -}; +} # sub commify_series { @@ -63,7 +61,7 @@ sub commify_series { (@_ == 1) ? $_[0] : (@_ == 2) ? join(" and ", @_) : join(", ", @_[0 .. ($#_-1)], "and $_[-1]"); -}; +} # sub search { @@ -73,13 +71,12 @@ sub search { my $resolv = Config::Auto::parse('/etc/resolv.conf'); my $servicetype = '_mdvonline._http._tcp.bonjour.'; - my @domains = (); - my @services = (); + my (@domains, @services); ! defined $resolv and logerr "No config found from /etc/resolv.conf.", return 0; defined $resolv->{domain} and @domains = $resolv->{domain}; - defined $resolv->{search} and push( @domains, @{$resolv->{search}} ); + defined $resolv->{search} and push @domains, @{$resolv->{search}}; @domains = uniq(@domains); for my $domain ( @domains ) { @@ -196,12 +193,12 @@ sub parse_txt_config { my ($this, @config) = @_; my $retconfig; - foreach my $line ( @config ) { + foreach my $line (@config) { # TODO match these with a regexp my @line = split('=', $line); my $key = shift(@line); my $value = join('=', @line); - switch( $key ) { + switch ($key) { case 'txtvers' { $retconfig->{txtvers} = $value; } case 'conf' { my @co = split(',', $value); @@ -220,4 +217,4 @@ sub parse_txt_config { return $retconfig; }; -1; \ No newline at end of file +1; diff --git a/mdkapplet b/mdkapplet index 4cb0a947..c1139973 100755 --- a/mdkapplet +++ b/mdkapplet @@ -42,12 +42,10 @@ mdkonline::is_running('mdkapplet') and die "mdkapplet already running\n"; my $in = interactive->vnew(''); ugtk2::add_icon_path("/usr/share/mdkonline/pixmaps/"); -my $arch = arch(); my $online_site = "https://www.mandrivaonline.com/"; -my ($menu, $timeout, $refreshtm, $networktm, $eventbox, $img, $av_pkgs, $update_label, $lastch, $mLog, $buffer, $textview, $wlog, $textvw, $state_global, $MW_vbox, $bubble_applet); -my ($need_update, $raisedwindow, $isAvailable, $debug, $conf_launched) = (0, 0, 0, 0, 0); +my ($menu, $timeout, $eventbox, $img, $mLog, $buffer, $textview, $wlog, $textvw, $state_global, $MW_vbox); +my ($raisedwindow, $debug, $conf_launched) = (0, 0, 0, 0); -my @proctable; my $conffile = '/etc/sysconfig/mdkonline'; my $localdir = "$ENV{HOME}/.MdkOnline"; @@ -165,8 +163,8 @@ ugtk2::exit(0); # Signal management sub harvester { - my ($signame, $clean) = @_; - my $childpid ; + my ($_signame, $clean) = @_; + my $childpid; do { $childpid = waitpid(-1, &WNOHANG); WIFEXITED($?) and refresh_gui(1); @@ -174,11 +172,11 @@ sub harvester { return if $clean; } sub fork_exec { - my ($prog, $pid_table) = @_; + my ($prog, $o_pid_table) = @_; my $pid = fork(); if (defined $pid) { !$pid and do { exec($prog) or POSIX::_exit() }; - push @$pid_table, $pid; + push @$o_pid_table, $pid if $o_pid_table; return $pid; } else { refresh_gui(1); @@ -198,8 +196,6 @@ sub showMainWindow() { $w->set_position('center'); $w->set_icon(Gtk2::Gdk::Pixbuf->new_from_file('/usr/share/icons/mini/mdkonline.png')); $textvw = Gtk2::TextView->new; - my ($choice, $time, $update_label, $lastch); - my $autocheck; gtkadd($w, gtkpack_($MW_vbox = Gtk2::VBox->new(0, 5), 0, gtkadd(gtkset_shadow_type(Gtk2::Frame->new(N("Actions")), 'etched_in'), @@ -224,7 +220,7 @@ sub showMainWindow() { ) ); $w->show_all; - gtkflush() + gtkflush(); } sub setLabel { my ($widget, $string) = shift; @@ -253,7 +249,7 @@ sub refresh_contents { $contents; } sub configNetwork() { logIt(N("Launching drakconnect\n")); refresh_gui(0); fork_exec("/usr/sbin/drakconnect") } -sub installUpdates { +sub installUpdates() { my $binfile = '/usr/bin/mdkapplet'; my $oldmd5 = $release <= 10.2 ? mdkonline::md5file($binfile) : common::md5file($binfile); logIt(N("Launching mdkupdate --applet\n")); @@ -267,12 +263,12 @@ sub installUpdates { my $mdkupdate_status = cat_('/var/tmp/mdkupdate.log'); if ($mdkupdate_status && $mdkupdate_status !~ /OK/) { logIt($mdkupdate_status); $in->ask_warn(N("Mandriva Linux Updates Applet"), $mdkupdate_status) } } -sub silentCheck { +sub silentCheck() { my $link = $online_site . "online3_RemoteAction.php" . '?action=UpdateList'; my %h = getVarsFromSh($conffile); my ($u, $ct); logIt(N("Computing new updates...\n")); - my $link = $link . '&log=' . $h{LOGIN} . '&host=' . $h{MACHINE}; + $link .= '&log=' . $h{LOGIN} . '&host=' . $h{MACHINE}; logIt(N("Connecting to") . " $link ...\n"); gtkflush(); go2State('busy'); gtkflush(); my $response = mdkonline::get_from_URL($link, 'MdkAppletAgent/0.1'); @@ -317,7 +313,7 @@ sub silentCheck { }; eval { $retcode->{$u}->() }; if ($@) { logIt(N("Problem occured while connecting to the server, please contact the support team")); go2State('critical') } } -sub okState { $isAvailable = 0; logIt(N("System is up-to-date\n")); go2State('okay') } +sub okState() { $isAvailable = 0; logIt(N("System is up-to-date\n")); go2State('okay') } sub compareWithInstalled { my ($name, $ver, $rel, $t) = @_; my $isUpdate = 0; @@ -334,7 +330,7 @@ sub compareWithInstalled { } $isUpdate; } -sub cronUpdate { +sub cronUpdate() { Glib::Timeout->add(10*1000, sub { checkConfig(); 1; @@ -344,23 +340,22 @@ sub cronUpdate { 1; }); } -sub lastCheck { +sub lastCheck() { my %h = getVarsFromSh($localfile); - my ($t, $l); - $t = $h{LASTCHECK}; + my $t = $h{LASTCHECK}; $t =~ s/_/ /g; $t || N("No check"); } -sub getTime { +sub getTime() { my $d = localtime(); $d =~ s/\s+/_/g; $d; } -sub setLastTime { +sub setLastTime() { my $date = getTime(); setVar($localfile, 'LASTCHECK', $date); } -sub checkConfig { +sub checkConfig() { if (!-e $conffile) { logIt(N("Checking config file: Not present\n")); go2State('noconfig'); @@ -371,7 +366,7 @@ sub checkConfig { silentCheck(); #- state has changed, update } } -sub checkUpdates { +sub checkUpdates() { member($state_global, qw(disconnected noconfig)) or silentCheck(); } sub go2State { @@ -381,7 +376,7 @@ sub go2State { $state_global = $state; defined $textvw and refresh_status($state); } -sub isNetwork { +sub isNetwork() { my $network; if ($release <= 10.0) { $network = gethostbyname("mandrivaonline.com") ? 1 : 0; @@ -402,12 +397,12 @@ sub isNetwork { } $network; } -sub configure { +sub configure() { refresh_gui(0); fork_exec("/usr/sbin/mdkonline"); $conf_launched = 1; } -sub displayLogs { +sub displayLogs() { my $w = ugtk2->new(N("Logs"), center => 1); gtkset_size_request($w->{window}, 500, 400); $w->{window}->signal_connect(delete_event => sub { $w->destroy; undef $wlog }); @@ -418,13 +413,13 @@ sub displayLogs { 1, create_scrolled_window(gtktext_insert($textview, $mLog)), 0, Gtk2::HSeparator->new, 0, gtkpack_(Gtk2::HBox->new(0, 5), - 0, gtksignal_connect(my $close = Gtk2::Button->new(N("Close")), + 0, gtksignal_connect(Gtk2::Button->new(N("Close")), clicked => sub { $w->destroy; undef $wlog; }), 1, Gtk2::Label->new(""), - 0, gtksignal_connect(my $clear = Gtk2::Button->new(N("Clear")), + 0, gtksignal_connect(Gtk2::Button->new(N("Clear")), clicked => sub { $mLog = ''; $buffer->set_text($mLog); @@ -447,7 +442,6 @@ sub setState { gtkset_tip(new Gtk2::Tooltips, $eventbox, formatAlaTeX(common::sprintf_fixutf8(translate($state{$state_type}{tt}[0])))); my $menu = Gtk2::Menu->new; foreach (@$arr) { - my $l = $actions{$_}{name}; $menu->append(gtksignal_connect(gtkshow(Gtk2::MenuItem->new_with_label($actions{$_}{name})), activate => $actions{$_}{launch})); } $menu->append(gtkshow(Gtk2::SeparatorMenuItem->new)); @@ -459,7 +453,7 @@ sub setState { } sub logIt { my $log = shift; - my ($Second, $Minute, $Hour, $Day, $Month, $Year, $WeekDay, $DayOfYear, $IsDST) = localtime(); + my ($Second, $Minute, $Hour, undef, undef, undef, undef, undef, undef) = localtime(); $mLog .= $Hour . ':' . $Minute . ':' . $Second . ' ' . $log; if (defined $wlog) { $buffer->insert_at_cursor($log) } } diff --git a/mdkonline b/mdkonline index 31823705..7d8aaf9b 100755 --- a/mdkonline +++ b/mdkonline @@ -37,13 +37,13 @@ BEGIN { unshift @::textdomains, 'mdkonline', 'drakfirstboot' } use mdkonline; use Digest::MD5 qw(md5 md5_hex md5_base64); -my $online_link = 'http://online3.mandriva.com/o/soap/'; +#my $online_link = 'http://online3.mandriva.com/o/soap/'; my $confdir = '/root/.MdkOnline'; my $conffile = "$confdir/mdkupdate"; my $logfile = '/var/tmp/mdkonline.log'; -my ($wiz, $greeting, $firstname, $lastname, $login, $account, $password, $npassword, $boxname, $cfmpassword, $email, $is_success, $key, $r, $createaccount, $sendconfres, $country, $ia, $gr, $alias); +my ($greeting, $firstname, $lastname, $login, $account, $password, $npassword, $boxname, $cfmpassword, $email, $is_success, $createaccount, $sendconfres, $country, $ia, $gr, $alias); my @info; @@ -74,7 +74,6 @@ $country = lang::c2name($locale->{country}); my $lang = $locale->{lang} || 'en_US'; my $descboxname; -my ($host_id, $host_key); sub get_conf() { my $wc = mdkonline::read_conf(); @@ -88,7 +87,7 @@ sub send_conf_via_soap { my $w = $in->wait_message(N("Please wait"), N("Reading configuration\n")) if $ia; my $reg_host = mdkonline::register_upload_host($login, $password, $boxname, $descboxname, $country); undef $w if $w; - $reg_host + $reg_host; } my $wiz = wizards->new( @@ -116,16 +115,16 @@ my $wiz = wizards->new( { label => N("Password:"), val => \$password, hidden => 1 }, { label => N("Machine name:"), val => \$boxname }, { label => N("Machine description:"), val => \$descboxname }, - { label => N("(Ex: My Home Office's Computer)")}, + { label => N("(Ex: My Home Office's Computer)") }, ]; }, post => sub { if (!mdkonline::check_valid_boxname($boxname)) { $is_success = N("Machine name must be 1 to 40 alphanumerical characters"); } else { - my $_wait = $in->wait_message(N("Please wait"), N("Connecting to Mandriva Online website...")) if $ia; + my $wait = $in->wait_message(N("Please wait"), N("Connecting to Mandriva Online website...")) if $ia; @info = ($login, $password); - $is_success = mdkonline::create_authenticate_account('authenticate', @info); undef($_wait); + $is_success = mdkonline::create_authenticate_account('authenticate', @info); undef $wait; } "authenticate"; }, @@ -135,7 +134,7 @@ my $wiz = wizards->new( if ($is_success eq 'OK') { N("In order to benefit from Mandriva Online services,\nwe are about to upload your configuration.\n\nThe Wizard will now send the following information to Mandriva:\n1) the list of packages you have installed on your system,\n2) your hardware configuration.\n\nIf you feel uncomfortable by that idea, or do not want to benefit from this service,\nplease press 'Cancel'. By pressing 'Next', you allow us to keep you informed\nabout security updates and useful upgrades via personalized email alerts.\nFurthermore, you benefit from discounted paid support services on\nwww.mandrivaexpert.com."); } else { - $is_success + $is_success; } }, no_back => $is_success eq 'OK' ? 1 : 0, @@ -150,7 +149,7 @@ my $wiz = wizards->new( name => N("Create a Mandriva Online Account"), data => sub { [ - { label => N("Greeting:"), val => \$greeting, list => [ @greets ], type => 'combo'}, + { label => N("Greeting:"), val => \$greeting, list => [ @greets ], type => 'combo' }, { label => N("First name:"), val => \$firstname }, { label => N("Last name:"), val => \$lastname }, { label => N("Email address:"), val => \$account }, diff --git a/mdkonline.pm b/mdkonline.pm index 433cc078..aaacf2a4 100644 --- a/mdkonline.pm +++ b/mdkonline.pm @@ -16,26 +16,24 @@ use SOAP::Lite; #For debugging use Data::Dumper; -my ($uri, $service_proxy, $online_proxy); +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 $release = get_release(); my $uri = !$testing ? 'https://online.mandriva.com/soap' : 'http://online3.mandriva.com/o/soap/'; $service_proxy = $online_proxy = $uri; -my $VERSION = 3; 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 $proxy = is_proxy(); my $s = $proxy == 2 ? SOAP::Lite->uri($uri)->proxy($service_proxy, proxy => [ 'http' => $ENV{https_proxy} ], agent => $useragent) @@ -43,7 +41,7 @@ my $s = $proxy == 2 ? 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 { +sub upgrade2v3() { my $res; if (-e $rootconf_file) { my %oc = getVarsFromSh($rootconf_file); @@ -54,7 +52,7 @@ sub upgrade2v3 { $res; } -sub get_rpmdblist { +sub get_rpmdblist() { my $rpmdblist = `rpm -qa --queryformat '%{HDRID};%{N};%{E};%{V};%{R};%{ARCH};%{OS};%{DISTRIBUTION};%{VENDOR};%{SIZE};%{BUILDTIME};%{INSTALLTIME}\n'`; $rpmdblist; } @@ -84,11 +82,11 @@ sub set_ua { $qualified_name; } -sub get_distro_type { +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 }; + { name => lc($name), 'arch' => $arch1 }; } sub soap_create_account { @@ -191,11 +189,11 @@ sub check_server_response { 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]} }; + foreach my $num ([9, 8], [21, 20]) { $hash_ret->{$num->[0]} = $hash_ret->{$num->[1]} } # print Dumper($response); my $code = $response->{code} || '99'; $response->{status} and write_conf($response); - return $response->{status} ? 'OK' : $hash_ret->{$code}->[0] . ' : ' . $hash_ret->{$code}->[1] . '\n\n' . $response->{message}; + return $response->{status} ? 'OK' : $hash_ret->{$code}[0] . ' : ' . $hash_ret->{$code}[1] . '\n\n' . $response->{message}; } sub check_valid_email { @@ -263,23 +261,23 @@ sub rpm_ver_cmp { } sub soap_recover_service { - my $data = $s->recoverHostFromV2(@_)->result(); + my $data = $s->recoverHostFromV2(@_)->result; $data; } sub soap_get_task { - my $data = $s->getTask(@_)->result(); + my $data = $s->getTask(@_)->result; $data; } sub soap_return_task_result { - my $data = $s->setTaskResult(@_)->result(); + my $data = $s->setTaskResult(@_)->result; $data; } sub soap_get_updates_for_host { - my $data = $s->getUpdatesForHost(@_)->result(); - $data + my $data = $s->getUpdatesForHost(@_)->result; + $data; } sub mv_files { @@ -287,7 +285,7 @@ sub mv_files { -e $source and system("mv", $source, $dest); } -sub clean_confdir { +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"; } @@ -298,7 +296,7 @@ sub hw_upload { -x $hw_exec && !-s '/etc/sysconfig/mdkonline' and system("HWDB_PASSWD=$passwd $hw_exec $login $hostname &"); } -sub automated_upgrades { +sub automated_upgrades() { output_p "/etc/cron.daily/mdkupdate", qq(#!/bin/bash if [ -f $conf_file ]; then /usr/sbin/mdkupdate --auto; fi @@ -326,11 +324,11 @@ sub write_wide_conf { my ($soap_response) = shift; # print Dumper($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}}); + %$conf_hash = getVarsFromSh($conf_file); + $conf_hash->{uc($_)} = $soap_response->{data}{$_} foreach keys %{$soap_response->{data}}; #print Dumper $conf_hash; $conf_hash->{DATE_SET} = $date; - foreach my $alias (['email','user_email'], ['customer_id', 'user_id']) { + 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)); @@ -339,26 +337,26 @@ sub write_wide_conf { sub is_running { my ($name) = @_; any { - my ($ppid, $pid, $n) = /^\s*(\d+)\s+(\d+)\s+(.*)/; + my ($_ppid, $pid, $n) = /^\s*(\d+)\s+(\d+)\s+(.*)/; $pid != $$ && $n eq $name; } `ps -o '%P %p %c' -u $ENV{USER}`; } # Romain: you need to finish those dns functions or drop them sub get_configuration { - my $in = shift; + my $_in = shift; my $config_file = '/etc/sysconfig/mdkonline'; my %conf;my $ret; # check local config file - if( ! ( -e $config_file ) || ! ( -s $config_file ) ) { + if (! (-e $config_file) || ! (-s $config_file)) { %conf = get_conf_from_dns(); - print "from dns:\n",Dumper(%conf),"\n"; + print "from dns:\n", Dumper(%conf), "\n"; } else { %conf = getVarsFromSh($config_file); - if( defined $conf{MACHINE} && ! defined $conf{VERSION} ) { + if (defined $conf{MACHINE} && !defined $conf{VERSION}) { $ret = upgrade_to_v3(); print "\n", $ret, "\n"; - if( $ret eq 1 ) { + if ($ret == 1) { # reload config %conf = getVarsFromSh($config_file); } @@ -370,15 +368,15 @@ sub get_configuration { } # now, a valid working config file is loaded - if( defined $conf{MOBILE} && $conf{MOBILE} eq 'TRUE' ) { + 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 ) { + my $info = $sd->search; + if ($info) { # TODO } else {} # nothing to do @@ -389,28 +387,28 @@ sub get_configuration { sub register_from_dns { my $dnsconf = shift; my ($hostinfo, $country ); - my $user = $dnsconf->{user}->{name}; - my $pass = $dnsconf->{user}->{pass}; + 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 ); + 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} ); + $res->{data}{service} = $dnsconf->{service}; + return mdkonline::save_config($res->{data}); } } -sub get_conf_from_dns { +sub get_conf_from_dns() { my $sd = new Discover; - my $info = $sd->search(); + 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 '' ) { + if ($info) { + if (defined $info->{user}{name} && defined $info->{user}{pass} && $info->{user}{name} ne '' && $info->{user}{pass} ne '') { print Dumper($info); # TODO check service certificate - $ret = mdkonline::register_from_dns( $info ); - if( $ret ) { + $ret = mdkonline::register_from_dns($info); + if ($ret) { return $ret; } } diff --git a/mdvonline_agent.pl b/mdvonline_agent.pl index 3b8ebfb2..980a366e 100644 --- a/mdvonline_agent.pl +++ b/mdvonline_agent.pl @@ -38,13 +38,13 @@ use Discover; use Log::Agent; require Log::Agent::Driver::File; # logging made to file logconfig( - -driver => Log::Agent::Driver::File->make( - -prefix => $0, - -showpid => 1, - -file => 'mdvonline.log', + '-driver' => Log::Agent::Driver::File->make( + '-prefix' => $0, + '-showpid' => 1, + '-file' => 'mdvonline.log', ), #-caller => [ -display => '($sub/$line)', -postfix => 1 ], - -priority => [ -display => '[$priority]' ], + '-priority' => [ '-display' => '[$priority]' ], ); logsay "=================="; @@ -58,21 +58,21 @@ print Dumper(%conf); logsay "checking for tasks"; print Dumper(%conf); -my $answer = mdkonline::soap_get_task( $conf{HOST_ID}, $conf{HOST_KEY} ); +my $answer = mdkonline::soap_get_task($conf{HOST_ID}, $conf{HOST_KEY}); print Dumper($answer); -if( $answer->{code} eq 0 ) { - if( $answer->{data}->{command} eq 'none' ) { +if ($answer->{code} == 0) { + if ($answer->{data}{command} eq 'none') { logsay "nothing to do"; } else { logsay "got something"; - my $res = mdkonline::run_and_return_task( $answer->{data} ); + mdkonline::run_and_return_task($answer->{data}); } exit 1; } else { - logwarn "something went wrong " . $answer->{message} . " (".$answer->{code}.")"; + logwarn "something went wrong " . $answer->{message} . " (" . $answer->{code} . ")"; exit 0; -} \ No newline at end of file +} -- cgit v1.2.1