You are not logged in.

#1 2018-04-04 19:02:51

Slithery
Administrator
From: Norfolk, UK
Registered: 2013-12-01
Posts: 5,776

Perl help needed - linode-longview

Hi folks.

I currently maintain the https://aur.archlinux.org/packages/longview/ package in the AUR, it's a system monitoring client for the Linode VPS provider.

One of the metrics that it monitors is available system updates, at present this only supports apt, yum, and Gentoo - the aim of this post is to hopefully provide a patch that will add pacman support - I believe that this may be possible without any backend changes (although I don't mind being proved incorrect). Unfortunately, I have zero knowledge of Perl so am asking all of you for some input; as my aim is to get this upstreamed I don't want to embarrass myself with rookie mistakes. I also don't run any of these other OS's anywhere to compare package manager outputs (Arch only baby smile)

I'll be using a fork of the official Github repo to do development in - https://github.com/slithery/longview-dev

What I've made out so far...

The modules in Extras/Modules/Packages are responsible for gathering package information, creating a new pacman.pm using these as a template and rewriting it's functions to use pacman/checkupdates should be straightforward for someone who's used perl before and is aquainted with these other package managers. For reference the existing modules are posted below...

APT.pm

package Linode::Longview::DataGetter::Packages::APT;

=head1 COPYRIGHT/LICENSE

Copyright 2013 Linode, LLC.  Longview is made available under the terms
of the Perl Artistic License, or GPLv2 at the recipients discretion.

=head2 Perl Artistic License

Read it at L<http://dev.perl.org/licenses/artistic.html>.

=head2 GNU General Public License (GPL) Version 2

  This program is free software; you can redistribute it and/or
  modify it under the terms of the GNU General Public License
  as published by the Free Software Foundation; either version 2
  of the License, or (at your option) any later version.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with this program.  If not, see http://www.gnu.org/licenses/

See the full license at L<http://www.gnu.org/licenses/>.

=cut

use strict;
use warnings;

use Linode::Longview::Util;

our $DEPENDENCIES = ['Processes.pm'];

our $next_run;
our $cache_touch_dt;

sub get {
	my ( undef, $dataref ) = @_;

	$logger->trace('Entering APT module');

	if(check_running($dataref)){
		$logger->debug('Another instance of apt-get is already running, skip package this pass');
		$dataref->{INSTANT}->{Packages} = [];
		return $dataref;
	}

	if(should_update()){
		$logger->trace('Running apt-get update before reporting packages');
		`apt-get -q update 2>/dev/null`;
	}

	my $new_touch_dt = (stat('/var/cache/apt/pkgcache.bin'))[9];

	return $dataref if (defined($cache_touch_dt) && ($new_touch_dt == $cache_touch_dt));
	$cache_touch_dt = $new_touch_dt;

	$dataref->{INSTANT}->{Packages} = [];

	my $held = 1;

	if (open(APT, "echo n | apt-get -q -V upgrade 2>&1 |")) {
		while (my $line = <APT>) {
			chomp($line);
			$held = 0 if ($line =~ m/^The following packages will be upgraded:/);
			if ($line =~ m/^\s+(\S+)\s+\((\S+)\s+=>\s+(\S+)\)/) {
				my $update = {};
				$update->{name} = $1;
				$update->{current} = $2;
				$update->{new} = $3;
				$update->{held} = $held;
				push @{$dataref->{INSTANT}->{Packages}}, $update;
			}
		}
		close(APT);
	}
	return $dataref;
}

sub should_update {
	return 0 if((defined $next_run) && ($next_run > time));
	$next_run = time + 86400; #Only actually hit the mirrors once every 24 hours.
	return 1;
}

sub check_running {
	my $dataref = shift;
	return grep(m/Processes\.apt(?:-get|itude)/,keys %{$dataref->{LONGTERM}});
}

1;

Gentoo.pm

package Linode::Longview::DataGetter::Packages::Gentoo;

=head1 COPYRIGHT/LICENSE

Copyright 2013 Linode, LLC.  Longview is made available under the terms
of the Perl Artistic License, or GPLv2 at the recipients discretion.

=head2 Perl Artistic License

Read it at L<http://dev.perl.org/licenses/artistic.html>.

=head2 GNU General Public License (GPL) Version 2

  This program is free software; you can redistribute it and/or
  modify it under the terms of the GNU General Public License
  as published by the Free Software Foundation; either version 2
  of the License, or (at your option) any later version.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with this program.  If not, see http://www.gnu.org/licenses/

See the full license at L<http://www.gnu.org/licenses/>.

=cut

use strict;
use warnings;

use Linode::Longview::Util;

our $DEPENDENCIES = [];

our $next_run;
our @pkgs;

sub get {
	my ( undef, $dataref ) = @_;

	$logger->trace('Entering Gentoo module');

	if(should_update()){
		@pkgs = qx(VERSION='<version>,' eix -u '-*' --format '<category>/<name> <installedversions:VERSION> <bestslotupgradeversions:VERSION>\n');
	}

	$dataref->{INSTANT}->{Packages} = [
		map {
			my ($name, $current, $new) = $_ =~ /^([^ ]+) (.+?), (.+?),$/;
			{
				name    => $name,
				current => join(', ', split(/,/, $current)),
				new     => join(', ', split(/,/, $new))
			}
		} @pkgs
	];
	return $dataref;
}

sub should_update {
	return 0 if((defined $next_run) && ($next_run > time));
	$next_run = time + 1800; # Checking updates is expensive; only do it every 30 minutes
	return 1;
}

1;

YUM.pm

package Linode::Longview::DataGetter::Packages::YUM;

=head1 COPYRIGHT/LICENSE

Copyright 2013 Linode, LLC.  Longview is made available under the terms
of the Perl Artistic License, or GPLv2 at the recipients discretion.

=head2 Perl Artistic License

Read it at L<http://dev.perl.org/licenses/artistic.html>.

=head2 GNU General Public License (GPL) Version 2

  This program is free software; you can redistribute it and/or
  modify it under the terms of the GNU General Public License
  as published by the Free Software Foundation; either version 2
  of the License, or (at your option) any later version.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with this program.  If not, see http://www.gnu.org/licenses/

See the full license at L<http://www.gnu.org/licenses/>.

=cut

use strict;
use warnings;

use Linode::Longview::Util;

our $DEPENDENCIES = [];

our $cache_touch_dt;

sub get {
	my (undef, $dataref) = @_;

	$logger->trace('Entering YUM module');

	return $dataref if defined $cache_touch_dt && get_DB_touch_dt() == $cache_touch_dt;

	my %u_pkgs = upgradable_pkgs();
	if (!%u_pkgs){
		$dataref->{INSTANT}->{Packages} = [];
		$cache_touch_dt = get_DB_touch_dt();
		return $dataref;
	}
	my %c_pkgs = current_pkgs();
	$dataref->{INSTANT}->{Packages} = [
		map {
			{
				name => $_,
				current => $c_pkgs{$_},
				new => $u_pkgs{$_}
			}
		}
		keys %u_pkgs
	];

	$cache_touch_dt = get_DB_touch_dt();
	return $dataref;
}

sub get_DB_touch_dt {
	my $oldest = 0;
	my $candidate;
	for my $db (glob('/var/lib/rpm/__db.*')) {
		$candidate = (stat($db))[9];
		$oldest = $candidate if $oldest < $candidate;
	}
	return $oldest;
}

sub current_pkgs {
	# yum wraps unless we fake a tty
	my @pkg_list = qx(script -c 'yum --color=never list installed' /dev/null);
	my %pkgs;
	for my $pkg (@pkg_list) {
		if ( $pkg =~ m/^(.*?)\s+(.*?)\s+@(.*)$/ ) {
			$pkgs{$1} = $2;
		}
	}
	return %pkgs;
}

sub upgradable_pkgs {
	my @pkg_list = qx(yum check-update);
	my %pkgs;
	for my $pkg (@pkg_list) {
		if ( $pkg =~ m/^(\S+\.\S+)\s+(\S+)\s+\S+$/ ) {
			$pkgs{$1} = $2;
		}
	}
	return %pkgs;
}

1;


I'm also presuming that a patch will be needed for the file that does the OS detection and runs the appropriate module, although I've not been able to find exactly where this is yet.

I know that I'm asking alot, but any help would be much appreciated.

Slithery.

Edit - I'd also be interested in testers, if there's anyone else that has a Linode account then either let me know here or PM me and you can have a go before I upload it to the AUR if you don't mind.


No, it didn't "fix" anything. It just shifted the brokeness one space to the right. - jasonwryan
Closing -- for deletion; Banning -- for muppetry. - jasonwryan

aur - dotfiles

Offline

Board footer

Powered by FluxBB