jlarson/snap
1
0
Fork 0
Code Issues 4 Pull Requests Projects Releases Wiki Activity
Files
997a8d69b51e83a7a6f912ee8087537f603eb209
snap/SRC/snap/snap.inprogress
Jay Larson 997a8d69b5 - Moved away from versioned directory for better tracking 
- Modified usher to set root password if not already set
 - Modified snap to deal with circular dependencies properly
 - Now snap properly checks exit value for usher postinst
2016-11-04 08:32:24 -05:00

2061 lines
40 KiB
Perl
Raw Blame History

#!/usr/bin/perl
### snap ###################################################
#
# This is the package management script for snap. It's
# quite a hack, and a bit messy currently. This will be
# cleaned up in time, but the initial goal is just to
# create something that works. It's not really too big
# to clean up later.
#
# Things to do!
# - Clean up $target, make sure it is correct for all subs
# - add 'usher' support (script executed from package):
# * built into ar archive
# * has preinst, postinst, prerm, postrm args
#
############################################################
use strict;
use warnings;
use IPC::Open3;
use IO::Select;
use IO::Socket;
use Compress::Zlib;
use Digest::SHA qw( sha256_hex );
use Data::Dumper;
my $snapver;
my $conffile = '/etc/snap.conf';
my $conf = readconf( $conffile );
my @opts = (
'info',
'list',
'hash',
'install',
'installed',
'reinstall',
'refresh',
'remove',
'search'
);
open( FILE, "</etc/snap_version" );
$snapver = <FILE>;
close( FILE );
chomp( $snapver );
sub readconf {
my $file = shift;
my $section = '';
my %data;
open( FILE, "<$file" ) || die( "open: $file: $!\n" );
while ( <FILE> ) {
chomp( $_ );
if ( $_ =~ /\[(\S+)\]/ ) {
$section = $1;
next;
}
elsif ( $_ =~ /(\S+)\s*=\s*(.*)$/ ) {
$data{$section}{$1} = $2;
}
}
close( FILE );
if ( ! $data{'general'}{'snapdir'} ) {
die( "readconf: $file: snapdir is required under [general]\n" );
}
elsif ( ! $data{'general'}{'pkgfile'} ) {
die( "readconf: $file: pkgfile is required under [general]\n" );
}
elsif ( ! $data{'sources'} ) {
die( "readconf: $file: no sources defined\n" );
}
return( \%data );
}
sub runcmd{
my $cmd = shift;
my %runcmd = (
sel => IO::Select->new(),
pid => 0,
stat => 0,
fh_out => '',
fh_err => ''
);
$runcmd{'pid'} = open3( \*CHLD_STDIN, \*CHLD_STDOUT,
\*CHLD_STDERR, $cmd );
close( CHLD_STDIN );
$runcmd{'sel'}->add( *CHLD_STDOUT, *CHLD_STDERR );
$runcmd{'fh_out'} = *CHLD_STDOUT;
$runcmd{'fh_err'} = *CHLD_STDERR;
return( %runcmd );
}
sub info{
my $pkgfile = shift;
my $target = shift || '';
my $pkgdir = "$target/$conf->{'general'}{'snapdir'}/$pkgfile";
my $cmd = "ar p $pkgfile snapinfo";
my %result = (
status => 0,
stdout => '',
stderr => '',
info => {
package => '',
version => '',
depends => '',
arch => '',
bytes => 0,
url => '',
description => ''
}
);
my $regex = '^('
. 'package'
. '|version'
. '|depends'
. '|arch'
. '|bytes'
. '|url'
. '|description'
. '):\s+(.*)';
my %runcmd;
my $el;
if ( ! -f $pkgfile && -f "$pkgdir/snapinfo" ){
my $snapinfo = "$pkgdir/snapinfo";
open( SNAPINFO, "<$snapinfo" );
while ( my $line = <SNAPINFO> ){
if ( $line =~ /$regex/ ){
$el = $1;
$result{'info'}{$el} = $2;
}
elsif ( $el ){
$result{'info'}{$el} .= $line;
}
}
return( \%result );
}
elsif ( ! -f $pkgfile ){
$result{'stderr'} = "No such package ($pkgfile) found";
$result{'status'} = -1;
return( \%result );
}
%runcmd = runcmd( $cmd );
while ( my @fhs = $runcmd{'sel'}->can_read ){
foreach my $fh ( @fhs ){
if ( eof( $fh ) ){
$runcmd{'sel'}->remove( $fh );
next;
}
if ( fileno( $fh ) == fileno( $runcmd{'fh_out'} ) ){
while ( my $line = <$fh> ){
$result{'stdout'} .= $line;
chomp( $line );
if ( $line =~ /$regex/ ){
$el = $1;
$result{'info'}{$el} = $2;
}
elsif ( $el ){
$result{'info'}{$el} .= $line;
}
}
}
elsif ( fileno( $fh ) == fileno( $runcmd{'fh_err'} ) ){
$result{'stderr'} .= <$fh>;
}
}
}
close( $runcmd{'fh_out'} );
close( $runcmd{'fh_err'} );
waitpid( $runcmd{'pid'}, 0 );
$result{'status'} = $? >> 8;
chomp( $result{'stdout'} );
chomp( $result{'stderr'} );
return( \%result );
}
sub list{
my $pkgfile = shift;
my $target = shift || '';
my $pkgdir = "$target/$conf->{'general'}{'snapdir'}/$pkgfile";
my $cmd = "ar p $pkgfile manifest";
my %result = (
status => 0,
stdout => '',
stderr => '',
list => []
);
my %runcmd;
if ( ! -f $pkgfile && -f "$pkgdir/manifest" ){
my $manifest = "$pkgdir/manifest";
open( MANIFEST, "<$manifest" );
while ( my $line = <MANIFEST> ){
my ( $sha256, $perms, $file ) = split( /\s+/, $line );
my $type = substr( $perms, 0, 1 );
if ( $file =~ /^\.{1,2}$/ ){
next;
}
push( @{$result{'list'}}, {
sha256 => $sha256,
perms => $perms,
file => $file,
type => $type
} );
}
close( MANIFEST );
return( \%result );
}
%runcmd = runcmd( $cmd );
while ( my @fhs = $runcmd{'sel'}->can_read ){
foreach my $fh ( @fhs ){
if ( eof( $fh ) ){
$runcmd{'sel'}->remove( $fh );
next;
}
if ( fileno( $fh ) == fileno( $runcmd{'fh_out'} ) ){
while ( my $line = <$fh> ){
my $sha256;
my $perms;
my $file;
my $type;
chomp( $line );
( $sha256, $perms, $file ) =
split( /\s/, $line );
$type = substr( $perms, 0, 1 );
push( @{$result{'list'}}, {
sha256 => $sha256,
perms => $perms,
file => $file,
type => $type
} );
}
}
elsif( fileno( $fh ) == fileno( $runcmd{'fh_err'} ) ){
$result{'stderr'} .= <$fh>;
}
}
}
close( $runcmd{'fh_out'} );
close( $runcmd{'fh_err'} );
waitpid( $runcmd{'pid'}, 0 );
$result{'status'} = $? >> 8;
chomp( $result{'stdout'} );
chomp( $result{'stderr'} );
return( \%result );
}
sub installed{
my $target = shift || '';
my $pkgsdir = "$target/$conf->{'general'}{'snapdir'}";
my %result;
opendir( DIR, $pkgsdir ) || die( "Error: $!" );
while ( my $file = readdir( DIR ) ){
if ( $file =~ /^\.{1,2}$/ || ! -d "$pkgsdir/$file" ){
next;
}
if ( -f "$pkgsdir/$file/snapinfo" ){
open( SNAPINFO, "<$pkgsdir/$file/snapinfo" )
|| die( "Error: $!" );
while ( my $line = <SNAPINFO> ){
if ( $line =~ /^package:\s*(\S+)$/ ){
$result{$file}{'package'} = $1;
}
elsif ( $line =~ /^version:\s*(\S+)$/ ){
$result{$file}{'version'} = $1;
}
elsif ( $line =~ /^bytes:\s*(\S+)$/ ){
$result{$file}{'bytes'} = $1;
}
elsif ( $line =~ /^description:\s*(.*)$/ ){
$result{$file}{'description'} = $1;
}
}
close( SNAPINFO );
}
}
close( DIR );
return( \%result );
}
sub repo {
my %packages;
foreach my $source ( keys( %{$conf->{'sources'}} ) ) {
my $file = "/$conf->{'general'}{'snapdir'}/$source-packages.gz";
my $data = gzopen( $file, 'r' );
my $buffer;
my $lastpkg;
while ( $data->gzreadline( $buffer ) > 0 ) {
if ( $buffer =~ /^package:\s+(.*)$/ ) {
$lastpkg = $1;
}
elsif ( $buffer =~ /^version:\s+(.*)$/ ) {
$packages{$lastpkg}{'version'} = $1;
}
elsif ( $buffer =~ /^depends:\s+(.*)$/ ) {
$packages{$lastpkg}{'depends'} = $1;
}
elsif ( $buffer =~ /^bytes:\s+(.*)$/ ) {
$packages{$lastpkg}{'bytes'} = $1;
}
elsif ( $buffer =~ /^description:\s+(.*)$/ ) {
$packages{$lastpkg}{'description'} = $1;
}
elsif ( $buffer =~ /^path:\s+(.*)$/ ) {
$packages{$lastpkg}{'path'} = $1;
}
elsif ( $buffer =~ /^sha256:\s+(.*)$/ ) {
$packages{$lastpkg}{'sha256'} = $1;
}
}
$data->gzclose();
}
return( \%packages );
}
sub hash{
my $pkgfile = shift;
my $result = {
status => 0,
stdout => '',
stderr => '',
hash => ''
};
if ( ! -f $pkgfile ){
$result->{'status'} = 1;
$result->{'stderr'} = "'$pkgfile' not a valid package file";
return( $result );
}
open( PKG, "$pkgfile" );
$result->{'hash'} = sha256_hex( <PKG> );
close( PKG );
return( $result );
}
sub human{
my $B = shift;
my $human;
if ( $B > 1099511627776 ){
$human = sprintf( '%.02f', $B / ( 1024 ** 4 ) ) . 'TB';
}
elsif ( $B > 1073741824 ){
$human = sprintf( '%.02f', $B / ( 1024 ** 3 ) ) . 'GB';
}
elsif ( $B > 1048576 ){
$human = sprintf( '%.02f', $B / ( 1024 ** 2 ) ) . 'MB';
}
else{
$human = sprintf( '%.02f', $B / 1024 ) . 'KB';
}
return( $human );
}
sub conflicts{
my $pkgfile = shift;
my $target = shift || '';
my $infodata = info( $pkgfile, $target );
my $listdata = list( $pkgfile );
my $snapdir = "$target/$conf->{'general'}{'snapdir'}";
my @conflicts;
print "Checking for conflicts...\n";
opendir( DIR, $snapdir ) || die( $! );
####################################################
#
# Need to re-write this a little more efficiently..
# Should we design a SQLite DB to hold this data??
#
# It would be preferable to stick with flat files
# and directories for simplicity...
#
####################################################
while ( my $pkgdir = readdir( DIR ) ){
if ( ! -d "$snapdir/$pkgdir" || $pkgdir =~ /^\.{1,2}$/ ||
$infodata->{'info'}{'package'} eq $pkgdir ){
next;
}
if ( ! -f "$snapdir/$pkgdir/manifest" ) {
next;
}
open( MANIFEST, "<$snapdir/$pkgdir/manifest" ) || die( $! );
while ( my $line = <MANIFEST> ){
( my $file = $line ) =~ s/.*\t//g;
chomp( $file );
foreach my $data ( @{$listdata->{'list'}} ){
if ( $data->{'file'} eq $file
&& $data->{'type'} ne 'd' ){
push( @conflicts, "$pkgdir: $file" );
last;
}
}
}
}
if ( @conflicts ){
return( \@conflicts );
}
else{
return 0;
}
}
sub depends {
my $packages = shift;
my $package = shift;
my $depends = shift;
if ( $packages->{$package} && $packages->{$package}{'depends'} ) {
foreach my $depend ( split( ',',
$packages->{$package}{'depends'} ) ) {
depends( $packages, $depend, $depends );
push( @$depends, $depend );
}
}
}
sub mkinfo{
my $target = shift || '';
my $infodir = "$target/usr/share/info";
opendir( INFODIR, "<$infodir" );
while ( my $file = readdir( INFODIR ) ){
if ( ! -f $file ){
next;
}
system( "cd $infodir && install-info $file dir" ) ||
return( 1 );
}
}
sub chkempty{
my $dir = shift;
my $empty = 1;
if ( ! -d $dir ) {
return;
}
opendir( DIR, $dir ) || die( $! );
while ( my $file = readdir( DIR ) ){
if ( $file =~ /^\.{1,2}$/ ){
next;
}
else{
$empty = 0;
last;
}
}
return( $empty );
}
sub usher{
my $pkgfile = shift;
my $target = shift || '';
my $stage = shift;
my $snapdir;
my $pkgdir;
my $infodata;
my $usher;
my %runcmd;
my $cmd = "ar -t $pkgfile";
my %result = (
status => 0,
stdout => '',
stderr => ''
);
$snapdir = "$target/$conf->{'general'}{'snapdir'}";
$infodata = info( $pkgfile, $target );
$pkgdir = "$snapdir/$infodata->{'info'}{'package'}";
%runcmd = runcmd( $cmd );
while ( my @fhs = $runcmd{'sel'}->can_read ){
local $| = 1;
foreach my $fh ( @fhs ){
if ( fileno( $fh ) == fileno( $runcmd{'fh_out'} ) ){
while ( my $line = <$fh> ){
chomp( $line );
if ( $line eq 'usher' ){
$usher = "$pkgdir/usher";
}
}
}
elsif( fileno( $fh ) == fileno( $runcmd{'fh_err'} ) ){
if ( ! $result{'stderr'} ){
$result{'stderr'} = <$fh>;
}
else{
$result{'stderr'} .= <$fh>;
}
}
if ( eof( $fh ) ){
$runcmd{'sel'}->remove( $fh );
}
}
}
close( $runcmd{'fh_out'} );
close( $runcmd{'fh_err'} );
waitpid( $runcmd{'pid'}, 0 );
$result{'status'} = $? >> 8;
if ( $result{'stdout'} ){
chomp( $result{'stdout'} );
}
if ( $result{'stderr'} ){
chomp( $result{'stderr'} );
}
if ( $result{'status'} || ! $usher ){
return( \%result );
}
if ( ! -d $pkgdir ){
mkdir( $pkgdir );
}
undef( $result{'stdout'} );
undef( $result{'stderr'} );
$cmd = "ar -p $pkgfile usher > $usher";
%runcmd = runcmd( $cmd );
while ( my @fhs = $runcmd{'sel'}->can_read ){
local $| = 1;
foreach my $fh ( @fhs ){
if ( fileno( $fh ) == fileno( $runcmd{'fh_out'} ) ){
if ( ! $result{'stdout'} ){
$result{'stdout'} = <$fh>;
}
else{
$result{'stdout'} .= <$fh>;
}
}
elsif( fileno( $fh ) == fileno( $runcmd{'fh_err'} ) ){
if ( ! $result{'stderr'} ){
$result{'stderr'} = <$fh>;
}
else{
$result{'stderr'} .= <$fh>;
}
}
if ( eof( $fh ) ){
$runcmd{'sel'}->remove( $fh );
}
}
}
close( $runcmd{'fh_out'} );
close( $runcmd{'fh_err'} );
waitpid( $runcmd{'pid'}, 0 );
$result{'status'} = $? >> 8;
if ( $result{'stdout'} ){
chomp( $result{'stdout'} );
}
if ( $result{'stderr'} ){
chomp( $result{'stderr'} );
}
if ( $result{'status'} ){
return( \%result );
}
undef( $result{'stdout'} );
undef( $result{'stderr'} );
chmod( 0700, $usher ) || do{
$result{'status'} = 1;
$result{'stderr'} = $!;
return( \%result );
};
if ( $target ) {
$cmd = "chroot $target && $usher $stage";
}
else {
$cmd = "$usher $stage";
}
%runcmd = runcmd( $cmd );
while ( my @fhs = $runcmd{'sel'}->can_read ){
local $| = 1;
foreach my $fh ( @fhs ){
if ( fileno( $fh ) == fileno( $runcmd{'fh_out'} ) ){
my $line = <$fh>;
if ( $line ){
print STDOUT $line;
}
}
elsif( fileno( $fh ) == fileno( $runcmd{'fh_err'} ) ){
my $line = <$fh>;
if ( $line ){
print STDERR $line;
}
}
if ( eof( $fh ) ){
$runcmd{'sel'}->remove( $fh );
}
}
}
close( $runcmd{'fh_out'} );
close( $runcmd{'fh_err'} );
waitpid( $runcmd{'pid'}, 0 );
$result{'status'} = $? >> 8;
if ( $result{'stdout'} ){
chomp( $result{'stdout'} );
}
if ( $result{'stderr'} ){
chomp( $result{'stderr'} );
}
return( \%result );
}
sub httpget {
my $url = shift;
my $dest = shift;
my $mode = shift;
( my $host = $url ) =~ s/^https?:\/\/|\/.*//g;
( my $file = $url ) =~ s/.*$host//;
my %httpget = (
'status' => '',
'length' => 0,
'type' => '',
'data' => '',
'dflag' => 0
);
my $sock = IO::Socket::INET->new(
PeerAddr => $host,
PeerPort => 'http(80)',
Proto => 'tcp'
) || die( $! );
my %result = (
status => 0,
stdout => '',
stderr => ''
);
$sock->send("GET $file HTTP/1.0\r\n");
$sock->send("Host: $host\r\n");
$sock->send("\r\n");
if ( $dest && $mode ) {
open( DEST, ">$dest" ) || do{
$result{'status'} = 1;
$result{'stderr'} = "open: $dest: $!";
return( \%result );
};
chmod( $mode, $dest ) || do{
$result{'status'} = 1;
$result{'stderr'} = "chmod: $dest: $!";
return( \%result );
}
}
elsif ( $dest && ! $mode ) {
die( "httpget: Provided dest ($dest) without mode!\n" );
}
while ( <$sock> ) {
if ( ! $httpget{'dflag'} ) {
if ( ! $httpget{'status'}
&& $_ =~ /^HTTP\S+\s(\d+)/ ) {
$httpget{'status'} = $1;
}
elsif ( ! $httpget{'date'}
&& $_ =~ /^Date:\s+(.*)/ ) {
$httpget{'date'} = $1;
}
elsif ( ! $httpget{'server'}
&& $_ =~ /^Server:\s+(.*)/ ) {
$httpget{'server'} = $1;
}
elsif ( ! $httpget{'lastmod'}
&& $_ =~ /^Last-Modified:\s+(.*)/ ) {
$httpget{'lastmod'} = $1;
}
elsif ( ! $httpget{'etag'}
&& $_ =~ /^ETag:\s+(.*)/ ) {
$httpget{'etag'} = $1;
}
elsif ( ! $httpget{'length'}
&& $_ =~ /Content-Length:\s+(\d+)/ ) {
$httpget{'length'} = $1;
}
elsif ( ! $httpget{'type'}
&& $_ =~ /Content-Type:\s+(\S+)/ ) {
$httpget{'type'} = $1;
}
elsif( $_ eq "\r\n" ) {
$httpget{'dflag'}++;
}
next;
}
if ( ! $dest ) {
$httpget{'data'} .= $_;
}
else {
print DEST $_;
}
}
close( $sock );
return( \%httpget );
}
sub install{
my $pkgfile = shift;
my $target = shift || '';
my $snapdir = "$target/$conf->{'general'}{'snapdir'}";
my $infodata;
my $confirm;
my $cmd;
my %runcmd;
my $install;
my $package;
my $version;
my $snapinfo;
my $manifest;
my $filenum = 0;
my $type = 0;
my $mkinfo = 0;
my $usher;
my %result = (
status => 0,
stdout => '',
stderr => ''
);
if ( ! -d $snapdir ) {
mkdirp( $snapdir, 0755 ) || die( $! );
}
$infodata = info( $pkgfile );
if ( $infodata->{'status'} ) {
$result{'status'} = $infodata->{'status'};
$result{'stdout'} = $infodata->{'stdout'};
$result{'stderr'} = $infodata->{'stderr'};
return( \%result );
}
$package = $infodata->{'info'}->{'package'};
$version = $infodata->{'info'}->{'version'};
$snapinfo = "$snapdir/$package/snapinfo";
$manifest = "$snapdir/$package/manifest";
print "Preparing to install $package-$version...\n";
if ( my $conflicts = conflicts( $pkgfile, $target ) ){
$result{'status'} = 1;
$result{'stderr'} = "Package $package conflicts"
. " with the following packages/files:\n"
. join( "\n", @$conflicts );
return( \%result );
}
####################################################
#
# If the package is already installed check the
# version and return if it is already installed
#
####################################################
if ( -f $snapinfo ){
open( SNAPINFO, "<$snapinfo" ) || die( $! );
while( my $line = <SNAPINFO> ){
if ( $line =~ /^version: (\S+)/ ){
my @sorted = sort( { vercmp( $a, $b ) }
( $1, $version ) );
if ( $sorted[0] eq $sorted[1] ){
$result{'status'} = -1;
$result{'stderr'} = "$package $version"
. " already installed";
return( \%result );
}
elsif ( $version eq $sorted[0] ){
$type = -1;
}
elsif ( $version eq $sorted[1] ){
$type = 1;
}
last;
}
}
close( SNAPINFO );
}
if ( ! $confirm ){
my $size = human( $infodata->{'info'}->{'bytes'} );
print "Package: $infodata->{'info'}->{'package'}\n"
. "Version: $infodata->{'info'}->{'version'}\n"
. "Size: $size\n";
if ( $type == -1 ){
print "Downgrade $package to $version on $target?"
. "(y/n): ";
}
elsif ( $type == 1 ){
print "Upgrade $package to $version on $target?"
. "(y/n): ";
}
else{
print "Install $package on $target? (y/n): ";
}
}
while( ! $confirm ){
$confirm = <STDIN>;
chomp( $confirm );
if ( lc( $confirm ) eq 'n' ){
print STDERR "Aborting installation\n";
exit 1;
}
elsif ( lc( $confirm ne 'y' ) ){
print "Answer 'y' or 'n': ";
undef( $confirm );
}
}
####################################################
#
# Here we copy the old manifest (if present) to a
# temp file to compare after installation and clean
# up any files from the old package that don't exist
# in the new one.
#
####################################################
if ( -f $manifest ){
open( MANIFEST, "<$manifest" ) || die( $! );
open( TMPMANIFEST, ">$manifest.tmp" ) || die( $! );
while ( my $line = <MANIFEST> ){
print TMPMANIFEST $line || die( $! );
}
close( MANIFEST );
close( TMPMANIFEST );
}
$usher = usher( $pkgfile, $target, 'preinst' );
if ( $usher->{'status'} ) {
$result{'status'} = $usher->{'status'};
$result{'stdout'} = $usher->{'stdout'};
$result{'stderr'} = $usher->{'stderr'};
return( \%result );
}
print "Extracting files for $infodata->{'info'}->{'package'}\n\n";
if ( $target ) {
$cmd = "ar p $pkgfile files.tar.gz|tar -hzvxf - -C $target";
}
else {
$cmd = "ar p $pkgfile files.tar.gz|tar -hzvxf - -C /";
}
%runcmd = runcmd( $cmd );
while ( my @fhs = $runcmd{'sel'}->can_read ){
local $| = 1;
foreach my $fh ( @fhs ){
if ( fileno( $fh ) == fileno( $runcmd{'fh_out'} ) ){
my $line = <$fh>;
( my $file = $line ) =~ s/.*\/|\n$//;
chomp( $file );
if ( $file ){
$filenum++;
print STDOUT "\e[?16;0;200c\033[K"
. "$file\r";
}
if ( $line
&& $line =~ /^\/usr\/share\/info\// ){
$mkinfo = 1;
}
}
elsif( fileno( $fh ) == fileno( $runcmd{'fh_err'} ) ){
print STDERR <$fh>;
}
if ( eof( $fh ) ){
$runcmd{'sel'}->remove( $fh );
}
}
}
close( $runcmd{'fh_out'} );
close( $runcmd{'fh_err'} );
waitpid( $runcmd{'pid'}, 0 );
$result{'status'} = $? >> 8;
chomp( $result{'stdout'} );
chomp( $result{'stderr'} );
if ( $mkinfo && ! $result{'status'} ){
if ( mkinfo( $target ) ){
$result{'status'} = 1;
$result{'stderr'} = 'Failed to update info db';
}
}
print STDOUT "\e[K$filenum files extracted\n";
usher( $pkgfile, $target, 'postinst' );
return( \%result );
}
sub reinstall{
my @args = @_;
my $pkgfile;
my $target;
my $infodata;
my $confirm;
my $cmd;
my %runcmd;
my $install;
my $snapdir;
my $package;
my $version;
my $snapinfo;
my $manifest;
my $listdata;
my $filenum = 0;
my $type = 0;
my $mkinfo = 0;
my %result = (
status => 0,
stdout => '',
stderr => ''
);
for ( my $i = $#args; $i >= 0; $i-- ){
if ( $args[$i] eq '-y' ){
splice( @args, $i, 1 );
$confirm = 'y';
}
elsif ( $args[$i] eq 'reinstall' ){
splice( @args, $i, 1 );
}
}
( $pkgfile, $target ) = @args;
if ( $target ){
$target =~ s/\/$//;
}
else{
$target = '/';
}
$snapdir = "$target/var/snap";
$infodata = info( $pkgfile, $target );
$package = $infodata->{'info'}->{'package'};
$version = $infodata->{'info'}->{'version'};
$snapinfo = "$snapdir/$package/snapinfo";
$manifest = "$snapdir/$package/manifest";
print "Preparing to re-install $package-$version...\n";
if ( my $conflicts = conflicts( $pkgfile, $target ) ){
$result{'status'} = 1;
$result{'stderr'} = "Package $package conflicts"
. " with the following packages/files:\n"
. join( "\n", @$conflicts );
return( \%result );
}
if ( -f $snapinfo ){
open( SNAPINFO, "<$snapinfo" ) || die( $! );
while( my $line = <SNAPINFO> ){
if ( $line =~ /^version: (\S+)/ ){
my @sorted = sort( { vercmp( $a, $b ) }
( $1, $version ) );
if ( $sorted[0] eq $sorted[1] ){
last;
}
else{
close( SNAPINFO );
$result{'status'} = -1;
$result{'stderr'} = "$package $version"
. " not already installed";
return( \%result );
}
}
}
close( SNAPINFO );
}
if ( ! $confirm ){
my $size = human( $infodata->{'info'}->{'bytes'} );
print "Package: $infodata->{'info'}->{'package'}\n"
. "Version: $infodata->{'info'}->{'version'}\n"
. "Size: $size\n";
print "Re-install $package on $target? (y/n): ";
}
while( ! $confirm ){
$confirm = <STDIN>;
chomp( $confirm );
if ( lc( $confirm ) eq 'n' ){
print STDERR "Aborting installation\n";
exit 1;
}
elsif ( lc( $confirm ne 'y' ) ){
print "Answer 'y' or 'n': ";
undef( $confirm );
}
}
####################################################
#
# Here we copy the old manifest (if present) to a
# temp file to compare after installation and clean
# up any files from the old package that done exist
# in the new one.
#
####################################################
open( MANIFEST, "<$manifest" ) || die( $! );
open( TMPMANIFEST, ">$manifest.tmp" ) || die( $! );
while ( my $line = <MANIFEST> ){
print TMPMANIFEST $line || die( $! );
}
close( MANIFEST );
close( TMPMANIFEST );
print "Extracting files for $infodata->{'info'}->{'package'}\n\n";
$cmd = "ar p $pkgfile files.tar.gz|tar -hzvxf - -C $target";
%runcmd = runcmd( $cmd );
while ( my @fhs = $runcmd{'sel'}->can_read ){
local $| = 1;
foreach my $fh ( @fhs ){
if ( fileno( $fh ) == fileno( $runcmd{'fh_out'} ) ){
my $line = <$fh>;
( my $file = $line ) =~ s/.*\/|\n$//;
chomp( $file );
if ( $file ){
$filenum++;
print STDOUT "\e[?16;0;200c\033[K"
. "$file\r";
}
if ( $line
&& $line =~ /^\/usr\/share\/info\// ){
$mkinfo = 1;
}
}
elsif( fileno( $fh ) == fileno( $runcmd{'fh_err'} ) ){
print STDERR <$fh>;
}
if ( eof( $fh ) ){
$runcmd{'sel'}->remove( $fh );
}
}
}
close( $runcmd{'fh_out'} );
close( $runcmd{'fh_err'} );
waitpid( $runcmd{'pid'}, 0 );
$result{'status'} = $? >> 8;
chomp( $result{'stdout'} );
chomp( $result{'stderr'} );
if ( $result{'status'} ){
return( \%result );
}
if ( $mkinfo && ! $result{'status'} ){
if ( mkinfo( $target ) ){
$result{'status'} = 1;
$result{'stderr'} = 'Failed to update info db';
return( \%result );
}
}
print STDOUT "\e[K$filenum files extracted\n";
return( \%result );
}
sub remove {
my @args = @_;
my $package;
my $target;
my $snapdir;
my $infodata;
my $listdata;
my $confirm;
my %result = (
status => 0,
stdout => '',
stderr => ''
);
for ( my $i = $#args; $i >= 0; $i-- ){
if ( $args[$i] eq '-y' ){
splice( @args, $i, 1 );
$confirm = 'y';
}
elsif ( $args[$i] eq 'remove' ){
splice( @args, $i, 1 );
}
}
$package = $args[0];
( $target = $args[1] || '' ) =~ s/\/$//;
$snapdir = "$target/$conf->{'general'}{'snapdir'}";
if ( ! $package ){
$result{'status'} = -1;
$result{'stderr'} = 'You must supply a package name';
return( \%result );
}
if ( -d "$snapdir/$package" ){
$infodata = info( $package, $target );
$listdata = list( $package, $target );
}
else{
$result{'stderr'} = "Package '$package' is not installed";
$result{'status'} = -1;
return( \%result );
}
if ( ! $confirm ){
my $size = human( $infodata->{'info'}->{'bytes'} );
print "Package: $infodata->{'info'}->{'package'}\n"
. "Version: $infodata->{'info'}->{'version'}\n"
. "Size: $size\n"
. "Remove $package from $target? (y/n): ";
}
while( ! $confirm ){
$confirm = <STDIN>;
chomp( $confirm );
if ( lc( $confirm ) eq 'n' ){
print STDERR "Aborting removal\n";
exit 1;
}
elsif ( lc( $confirm ne 'y' ) ){
print "Answer 'y' or 'n': ";
undef( $confirm );
}
}
foreach my $data ( @{$listdata->{'list'}} ){
if ( $data->{'type'} ne 'd' ){
unlink( "$target/$data->{'file'}" );
}
}
foreach my $data ( @{$listdata->{'list'}} ){
if ( $data->{'type'} eq 'd' ){
if ( chkempty( "$target/$data->{'file'}" ) ){
rmdir( "$target/$data->{'file'}" );
}
}
}
opendir( DIR, "$snapdir/$package" );
while ( my $file = readdir( DIR ) ){
if ( $file !~ /^\.{1,2}$/ ){
unlink( "$snapdir/$package/$file" ) || die( $! );
}
}
rmdir( "$snapdir/$package" ) || die( $! );
return( \%result );
}
sub manifest{
my @args = @_;
my $pkgfile;
my $target;
my $infodata;
my $listdata;
my $snapdir;
my $cmd;
my %runcmd;
my %result = (
status => 0,
stdout => '',
stderr => ''
);
for ( my $i = $#args; $i >= 0; $i-- ){
if ( $args[$i] eq '-y' ){
splice( @args, $i, 1 );
}
elsif ( $args[$i] =~ /(re)*install/ ){
splice( @args, $i, 1 );
}
}
( $pkgfile, $target ) = @args;
if ( $target ){
$target =~ s/\/$//;
}
else{
$target = '';
}
$infodata = info( $pkgfile, $target );
$listdata = list( $pkgfile );
$snapdir = "$target/var/snap/$infodata->{'info'}->{'package'}";
mkdir( "$snapdir" );
$cmd = "ar p $pkgfile manifest > $snapdir/manifest";
%runcmd = runcmd( $cmd );
while ( my @fhs = $runcmd{'sel'}->can_read ){
foreach my $fh ( @fhs ){
if ( eof( $fh ) ){
$runcmd{'sel'}->remove( $fh );
next;
}
if ( fileno( $fh ) == fileno( $runcmd{'fh_out'} ) ){
$result{'stdout'} .= <$fh>;
}
elsif( fileno( $fh ) == fileno( $runcmd{'fh_err'} ) ){
$result{'stderr'} .= <$fh>;
}
}
}
close( $runcmd{'fh_out'} );
close( $runcmd{'fh_err'} );
waitpid( $runcmd{'pid'}, 0 );
$result{'status'} = $? >> 8;
chomp( $result{'stdout'} );
chomp( $result{'stderr'} );
return( \%result );
}
sub mkdirp{
( my $dir = shift ) =~ s/\/^//;
my $mode = shift;
( my $parent = $dir ) =~ s/\/[^\/]+$//;
if ( -d $dir ){
return;
}
mkdirp( $parent, $mode );
mkdir( $dir ) || return( $! );
}
sub snapinfo{
my @args = @_;
my $pkgfile;
my $target;
my $infodata;
my $snapdir;
my $cmd;
my %runcmd;
my %result = (
status => 0,
stdout => '',
stderr => ''
);
for ( my $i = $#args; $i >= 0; $i-- ){
if ( $args[$i] eq '-y' ){
splice( @args, $i, 1 );
}
elsif ( $args[$i] =~ /(re)*install/ ){
splice( @args, $i, 1 );
}
}
( $pkgfile, $target ) = @args;
if ( $target ){
$target =~ s/\/$//;
}
else{
$target = '';
}
$infodata = info( $pkgfile, $target );
$snapdir = "$target/var/snap/$infodata->{'info'}->{'package'}";
mkdir( "$snapdir" );
$cmd = "ar p $pkgfile snapinfo > $snapdir/snapinfo";
%runcmd = runcmd( $cmd );
while ( my @fhs = $runcmd{'sel'}->can_read ){
foreach my $fh ( @fhs ){
if ( eof( $fh ) ){
$runcmd{'sel'}->remove( $fh );
next;
}
if ( fileno( $fh ) == fileno( $runcmd{'fh_out'} ) ){
$result{'stdout'} .= <$fh>;
}
elsif( fileno( $fh ) == fileno( $runcmd{'fh_err'} ) ){
$result{'stderr'} .= <$fh>;
}
}
}
close( $runcmd{'fh_out'} );
close( $runcmd{'fh_err'} );
waitpid( $runcmd{'pid'}, 0 );
$result{'status'} = $? >> 8;
chomp( $result{'stdout'} );
chomp( $result{'stderr'} );
return( \%result );
}
sub search {
my $searchstring = shift;
foreach my $source ( keys( %{$conf->{'sources'}} ) ) {
my $file = "/$conf->{'general'}{'snapdir'}/$source-packages.gz";
my $data = gzopen( $file, 'r' );
my $buffer;
my @packages;
while ( $data->gzreadline( $buffer ) > 0 ) {
if ( $buffer =~ /^package:\s+(.*)$/ ) {
print "$1";
}
elsif ( $buffer =~ /^version:\s+(.*)$/ ) {
print "-$1";
}
elsif ( $buffer =~ /^description:\s+(.*)$/ ) {
print " - $1\n";
}
}
$data->gzclose();
}
}
sub sttysize {
my %size = (
width => 0,
height => 0
);
my $cmd = 'stty size';
my %runcmd = runcmd( $cmd );
my %result = (
status => 0,
stdout => '',
stderr => ''
);
while ( my @fhs = $runcmd{'sel'}->can_read ){
foreach my $fh ( @fhs ){
if ( eof( $fh ) ){
$runcmd{'sel'}->remove( $fh );
next;
}
if ( fileno( $fh ) == fileno( $runcmd{'fh_out'} ) ){
while ( my $line = <$fh> ){
$result{'stdout'} .= $line;
}
}
elsif ( fileno( $fh ) == fileno( $runcmd{'fh_err'} ) ){
$result{'stderr'} .= <$fh>;
}
}
}
close( $runcmd{'fh_out'} );
close( $runcmd{'fh_err'} );
waitpid( $runcmd{'pid'}, 0 );
$result{'status'} = $? >> 8;
chomp( $result{'stdout'} );
chomp( $result{'stderr'} );
return( \%result );
}
### vercmp() ###############################################
#
# This subroutine was basically copied verbatim from the
# Sort::Versions module. It was modified slightly so that
# it more closely matched the aesthetics of the rest of
# the snap code. The following credits were provided within
# the documentation of that module:
#
# Ed Avis <ed@membled.com> and Matt Johnson
# <mwj99@doc.ic.ac.uk> for recent releases; the original
# author is Kenneth J. Albanowski <kjahds@kjahds.com>.
# Thanks to Hack Kampbjørn and Slaven Rezic for patches
# and bug reports.
#
# Copyright (c) 1996, Kenneth J. Albanowski. All rights
# reserved. This program is free software; you can
# redistribute it and/or modify it under the same terms as
# Perl itself.
#
############################################################
sub vercmp{
my @A = ( $_[0] =~ /([-.]|\d+|[^-.\d]+)/g );
my @B = ( $_[1] =~ /([-.]|\d+|[^-.\d]+)/g );
my ( $A, $B );
while ( @A and @B ){
$A = shift @A;
$B = shift @B;
if ( $A eq '-' and $B eq '-' ){
next;
}
elsif ( $A eq '-' ){
return -1;
}
elsif ( $B eq '-' ){
return 1;
}
elsif ( $A eq '.' and $B eq '.' ){
next;
}
elsif ( $A eq '.' ){
return -1;
}
elsif ( $B eq '.' ){
return 1;
}
elsif ( $A =~ /^\d+$/ and $B =~ /^\d+$/ ){
if ( $A =~ /^0/ || $B =~ /^0/ ){
return $A cmp $B if $A cmp $B;
}
else{
return $A <=> $B if $A <=> $B;
}
}
else{
$A = uc $A;
$B = uc $B;
return $A cmp $B if $A cmp $B;
}
}
@A <=> @B;
}
if ( $ARGV[0] eq 'info' ){
my $result = info( $ARGV[1], $ARGV[2] || '' );
my $info = $result->{'info'};
if ( $result->{'status'} ){
print STDERR "snap Error: $result->{'stderr'}\n";
exit $result->{'status'};
}
print "package: $info->{'package'}\nversion: $info->{'version'}\n";
print "depends: $info->{'depends'}\n";
print "bytes: $info->{'bytes'}\nurl: $info->{'url'}\n";
print "description: $info->{'description'}\n";
exit 0;
}
elsif ( $ARGV[0] eq 'list' && $ARGV[1] ){
my $result = list( $ARGV[1], $ARGV[2] || '' );
my $list = $result->{'list'};
if ( $result->{'status'} ){
print "snap Error: $result->{'stderr'}\n";
exit $result->{'status'};
}
foreach my $row ( @$list ){
if ( $row->{'type'} eq 'd' ){
next;
}
print "$row->{'sha256'}\t$row->{'file'}\n";
}
}
elsif ( $ARGV[0] eq 'installed' ){
my $result = installed( $ARGV[1] || '' );
foreach my $key ( sort( keys( %{$result} ) ) ){
if ( $result->{$key}{'package'} && -t STDOUT ){
printf( '%-10.10s ', $result->{$key}{'package'} );
}
elsif ( $result->{$key}{'package'} ){
printf( '%-30.30s', $result->{$key}{'package'} );
}
else{
printf( '%-10.10s ', 'UNKNOWN' );
}
if ( $result->{$key}{'version'} && -t STDOUT ){
printf( '%-10.10s ', $result->{$key}{'version'} );
}
elsif ( $result->{$key}{'version'} ){
printf( '%-20.20s', $result->{$key}{'version'} );
}
else{
printf( '%-10.10s ', 'UNKNOWN' );
}
if ( $result->{$key}{'description'} && -t STDOUT ){
printf( '%.58s', $result->{$key}{'description'} );
}
elsif ( $result->{$key}{'description'} ){
print "$result->{$key}{'description'}";
}
else{
printf( '%.58s', ' ' );
}
print "\n";
}
}
elsif ( $ARGV[0] eq 'hash' ){
my $result = hash( $ARGV[1] );
my $hash = $result->{'hash'};
if ( $result->{'status'} ){
print STDERR "snap Error: $result->{'stderr'}\n";
exit $result->{'status'};
}
print "$hash\n";
}
elsif ( $ARGV[0] eq 'install' ){
my $packages = repo();
my $installed = installed();
my $result; # = install( @ARGV );
my $infodata;
my $listdata;
my $manifest;
my $package;
my @depends;
my @depfails;
my $size = 0;
my $yes = 0;
my $target;
for ( my $i = 0; $i <= $#ARGV; $i++ ){
if ( $ARGV[$i] eq 'install' ){
next;
}
elsif ( $ARGV[$i] eq '-y' ){
$yes++;
next;
}
if ( ! $package ){
$package = $ARGV[$i];
}
else{
$target = $ARGV[$i];
}
}
if ( ! -f $package ) {
if ( ! $packages->{$package} ) {
print STDERR "$package is not a valid snap file"
. " and not available in any repos\n";
exit 1;
}
}
else {
my $info = info( $package );
if ( $installed->{$info->{'info'}{'package'}} &&
$packages->{$package}{'version'} eq
$installed->{$info->{'info'}{'package'}} ) {
print STDERR "$package $info->{'info'}{'version'}"
. " is already installed\n";
exit 1;
}
$packages->{$package} = $info->{'info'};
}
depends( $packages, $package, \@depends );
for ( my $i = $#depends; $i >= 0; $i-- ) {
if ( $installed->{$depends[$i]} ) {
splice( @depends, $i, 1 );
}
}
foreach my $pkg ( ( @depends, $package ) ) {
if ( ! $packages->{$pkg} ) {
push( @depfails, $pkg );
}
else {
$size += $packages->{$pkg}{'bytes'};
}
}
if ( @depfails ) {
print STDERR "The following dependencies are not"
. " available in any repos:\n";
foreach my $depfail ( sort( @depfails ) ) {
print STDERR " $depfail\n";
}
exit 1;
}
if ( ! $yes ){
if ( @depends ) {
print "The following dependencies will need to be"
. " installed:\n"
. join( ' ', @depends ) . "\n";
}
print "Total size on disk: " . human( $size )
. " ($size bytes)\n";
if ( $installed->{$package} ) {
print "Would you like to upgrade $package"
. " ($installed->{$package}{'version'}"
. " to $packages->{$package}{'version'})"
. "? (y/n): ";
}
# if ( $type == -1 ){
# print "Downgrade $package to $version on $target?"
# . "(y/n): ";
# }
# elsif ( $type == 1 ){
# print "Upgrade $package to $version on $target?"
# . "(y/n): ";
# }
# else{
# print "Install $package on $target? (y/n): ";
# }
}
while( ! $yes ){
$yes = <STDIN>;
chomp( $yes );
if ( lc( $yes ) eq 'n' ){
print STDERR "Aborting installation\n";
exit 1;
}
elsif ( lc( $yes ne 'y' ) ){
print "Answer 'y' or 'n': ";
undef( $yes );
}
}
print "SIZE: $size\n";
exit;
if ( ! $target ){
$target = '/';
}
$manifest .= "$target/var/snap/$infodata->{'info'}{'package'}/manifest";
if ( $result->{'status'} ){
print STDERR "snap Error: $result->{'stderr'}\n";
exit $result->{'status'};
}
else{
############################################
#
# Here we use manifest() and snapinfo()
# to write the manifest and snapinfo
# files in /var/snap/packagename
#
############################################
$result = manifest( @ARGV );
if ( $result->{'status'} ){
print STDERR "snap Error: $result->{'stderr'}\n";
exit $result->{'status'};
}
$result = snapinfo( @ARGV );
if ( $result->{'status'} ){
print STDERR "snap Error: $result->{'stderr'}\n";
exit $result->{'status'};
}
}
############################################
#
# In this section we check to see if
# $manifest.tmp exists (which means an
# already installed package is being
# replaced (reinstall, upgrade, etc).
# This keeps us from being left with
# orphaned files.
#
############################################
if ( -f "$manifest.tmp" ){
open( TMPMANIFEST, "<$manifest.tmp" ) || die( $! );
$listdata = list( $package );
while ( my $line = <TMPMANIFEST> ){
my ( $sha256, $perms, $file ) = split( /\s/, $line );
my $match = 0;
foreach my $data ( @{$listdata->{'list'}} ){
if ( $file eq $data->{'file'} ){
$match = 1;
last;
}
}
if ( ! $match ){
if ( -d "$target/$file"
&& chkempty( "$target/$file" ) ){
rmdir( "$target/$file" ) || die( $! );
}
elsif ( -f "$target/$file" ){
unlink( "$target/$file" ) || die( $! );
}
}
}
close( TMPMANIFEST );
unlink( "$manifest.tmp" ) || die( $! );
}
print "Package successfully installed\n\n";
}
elsif ( $ARGV[0] eq 'reinstall' ){
my $result = reinstall( @ARGV );
my $infodata;
my $listdata;
my $manifest;
my $pkgfile;
my $target;
for ( my $i = $#ARGV; $i >= 0; $i-- ){
if ( $ARGV[$i] eq '-y' ){
next;
}
elsif ( $ARGV[$i] eq 'reinstall' ){
next;
}
if ( ! $pkgfile ){
$pkgfile = $ARGV[$i];
}
else{
$target = $ARGV[$i];
}
}
$infodata = info( $pkgfile, $target );
if ( ! $target ){
$target = '/';
}
$manifest .= "$target/var/snap/$infodata->{'info'}{'package'}/manifest";
if ( $result->{'status'} ){
print STDERR "snap Error: $result->{'stderr'}\n";
exit $result->{'status'};
}
else{
############################################
#
# Here we use manifest() and snapinfo()
# to write the manifest and snapinfo
# files in /var/snap/packagename
#
############################################
$result = manifest( @ARGV );
if ( $result->{'status'} ){
print STDERR "snap Error: $result->{'stderr'}\n";
exit $result->{'status'};
}
$result = snapinfo( @ARGV );
if ( $result->{'status'} ){
print STDERR "snap Error: $result->{'stderr'}\n";
exit $result->{'status'};
}
############################################
#
# In this section we look through the files
# in the old package and remove them if they
# aren't in the new package. This
# functionality should probably be made
# into a sub at some point.
#
############################################
open( TMPMANIFEST, "<$manifest.tmp" ) || die( $! );
$listdata = list( $pkgfile );
while ( my $line = <TMPMANIFEST> ){
my ( $sha256, $perms, $file ) = split( /\s/, $line );
my $match = 0;
foreach my $data ( @{$listdata->{'list'}} ){
if ( $file eq $data->{'file'} ){
$match = 1;
last;
}
}
if ( ! $match ){
if ( -d "$target/$file"
&& chkempty( "$target/$file" ) ){
rmdir( "$target/$file" ) || die( $! );
}
elsif ( -f "$target/$file" ){
unlink( "$target/$file" ) || die( $! );
}
}
}
close( TMPMANIFEST );
unlink( "$manifest.tmp" ) || die( $! );
print "Package successfully re-installed\n\n";
}
}
elsif ( $ARGV[0] eq 'refresh' ) {
foreach my $source ( keys( %{$conf->{'sources'}} ) ) {
( my $src = "$conf->{'sources'}{$source}" ) =~ s/\/$//;
my $dest = "/$conf->{'general'}{'snapdir'}/$source-packages.gz";
my $mode = 0644;
my $packages;
print "Retrieving packages for source '$source'... ";
$packages = httpget( "$src/$snapver/packages.gz",
$dest, $mode );
if ( $packages->{'status'} == 200 ) {
print "Success\n";
}
else {
print "Failed!\nhttpget: $packages->{'stderr'}\n";
}
}
}
elsif ( $ARGV[0] eq 'remove' ){
my $result = remove( @ARGV );
if ( $result->{'status'} ){
print STDERR "snap Error: $result->{'stderr'}\n";
exit $result->{'status'};
}
else{
print "\nPackage successfully removed\n\n";
}
}
elsif ( $ARGV[0] eq 'repo' ) {
my $packages = repo();
foreach my $package ( sort( keys( %{$packages} ) ) ) {
print "$package - $packages->{$package}{'description'}\n";
}
}
elsif ( $ARGV[0] eq 'search' ) {
my $packages = repo();
foreach my $package ( sort( keys( %{$packages} ) ) ) {
if ( index( $package, $ARGV[1] ) != -1 ||
index( $packages->{$package}{'description'}, $ARGV[1] ) != -1) {
print "$package - "
. "$packages->{$package}{'description'}\n";
}
}
}
else{
print STDERR "snap Error: $ARGV[0] is not a valid argument\n";
exit 1;
}
Reference in New Issue View Git Blame Copy Permalink