Jay Larson
6b62f87bf6
* Cleaned up some output and variable assignments * Added additional error handling/output * Implemented 'source' command (git clones) * More variable requirements for Makefile.snaplinux * Package.pm is now more sane in dealing with the package object * Added chroot/fakechroot (will likely need further tweaking!) * Improved locking * Added ability to use templates for snapinstall (will be expanded!)
1144 lines
24 KiB
Perl
1144 lines
24 KiB
Perl
package Snap::Package;
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Fcntl;
|
|
use IPC::Open3;
|
|
use IO::Select;
|
|
use Cwd 'abs_path';
|
|
use Data::Dumper;
|
|
|
|
use parent 'Snap';
|
|
|
|
############################################################
|
|
#
|
|
# The FIELDS constant defines all available attributes for
|
|
# package files. The following is a brief description of
|
|
# each:
|
|
#
|
|
# * arch: The architecture for which the package is built
|
|
# * brief: short desription of package
|
|
# * builddeps: dependencies for building the package
|
|
# * bytes: total bytes of installed package
|
|
# * depends: comma separated list of package dependencies
|
|
# * description: long description of package
|
|
# * name: package name
|
|
# * path: path to package, either local or repo file
|
|
# * repo: repository where package is located, empty for
|
|
# local file
|
|
# * sha256: sha256sum for package file
|
|
# * sha256man: sha256sum for package manifest file
|
|
# * source: source server
|
|
# * srcpkg: name of git repo for package source
|
|
# * status: status of package currently one of:
|
|
# installed
|
|
# installing
|
|
# removing
|
|
# uninstalled
|
|
# upgrading
|
|
# * status: The current status of the package, one of:
|
|
# * url: upstream source url
|
|
# * version: version string
|
|
#
|
|
############################################################
|
|
|
|
use constant FIELDS => qw(
|
|
name
|
|
version
|
|
arch
|
|
depends
|
|
builddeps
|
|
srcpkg
|
|
status
|
|
bytes
|
|
url
|
|
path
|
|
source
|
|
repo
|
|
sha256
|
|
sha256man
|
|
brief
|
|
description
|
|
);
|
|
|
|
### new() ##################################################
|
|
#
|
|
# This creates a new package object. The attributes are
|
|
# defined in the FIELDS constant.
|
|
#
|
|
############################################################
|
|
|
|
sub new {
|
|
my $class = shift;
|
|
my $package = shift;
|
|
my $infofile = Snap->INSTDIR . "/$package/snapinfo";
|
|
my $self = {};
|
|
|
|
if ( ref( $package ) ) {
|
|
foreach my $attr ( FIELDS ) {
|
|
$self->{$attr} = $package->{$attr};
|
|
}
|
|
}
|
|
elsif ( -f $package && Snap->issnap( $package ) ) {
|
|
my $sel = IO::Select->new();
|
|
my $stdout;
|
|
my $stderr;
|
|
my $stat;
|
|
my $pid = open3( \*CHLDIN, \*CHLDOUT, \*CHLDERR,
|
|
"/usr/bin/ar p $package snapinfo" );
|
|
|
|
close( CHLDIN );
|
|
|
|
$sel->add( *CHLDOUT, *CHLDERR );
|
|
|
|
while ( my @fhs = $sel->can_read ) {
|
|
foreach my $fh ( @fhs ) {
|
|
if ( eof( $fh ) ) {
|
|
$sel->remove( $fh );
|
|
|
|
next;
|
|
}
|
|
|
|
if ( fileno( $fh ) == fileno( *CHLDOUT ) ) {
|
|
$stdout .= <$fh>;
|
|
}
|
|
elsif ( fileno( $fh ) == fileno( *CHLDERR ) ) {
|
|
$stderr .= <$fh>;
|
|
}
|
|
}
|
|
}
|
|
|
|
close( CHLDOUT );
|
|
close( CHLDERR );
|
|
|
|
waitpid( $pid, 0 );
|
|
$stat = $? >> 8;
|
|
|
|
if ( $stat ) {
|
|
Snap->error( $stat,
|
|
"Failed to read $package: $stderr" );
|
|
}
|
|
|
|
foreach ( split( /\n/, $stdout ) ) {
|
|
if ( $_ =~ /^(\S+):\s*(.*)$/ ) {
|
|
$self->{$1} = $2;
|
|
}
|
|
}
|
|
|
|
$self->{'source'} = 'localhost';
|
|
$self->{'path'} = abs_path( $package );
|
|
}
|
|
elsif ( -f $infofile ) {
|
|
open( SNAPINFO, "<$infofile" ) ||
|
|
Snap->error( int( $! ), "open(): $infofile: $!" );
|
|
|
|
while( <SNAPINFO> ) {
|
|
####################################
|
|
#
|
|
# Temporary fix!!! Will need to
|
|
# remove after all packages are
|
|
# corrected...
|
|
#
|
|
####################################
|
|
|
|
$_ =~ s/^package:/name:/;
|
|
|
|
if ( $_ = /^(\S+):\s+(.*)$/ ) {
|
|
$self->{$1} = $2;
|
|
}
|
|
}
|
|
|
|
close( SNAPINFO ) ||
|
|
Snap->error( int( $! ), "close(): $infofile: $!" );
|
|
|
|
$self->{'status'} = 'installed';
|
|
}
|
|
else {
|
|
Snap->error( -2, "'$package': No such file or package found" );
|
|
}
|
|
|
|
if ( ! $self->{'srcpkg'} ) {
|
|
$self->{'srcpkg'} = $self->{'name'};
|
|
}
|
|
|
|
return( bless( $self, $class ) );
|
|
}
|
|
|
|
sub conflicts {
|
|
my $self = shift;
|
|
my $sources = shift;
|
|
my $conflicts = {};
|
|
|
|
$self->files( { quiet => 1 } );
|
|
|
|
foreach my $pkgname ( keys( %{$sources->{'installed'}} ) ) {
|
|
if ( $pkgname eq $self->{'name'} ) {
|
|
next;
|
|
}
|
|
|
|
my $installed = $sources->{'installed'}{$pkgname};
|
|
|
|
foreach my $file ( @{$installed->{'files'}} ) {
|
|
if ( grep( $_ eq $file, @{$self->{'files'}} ) ) {
|
|
if ( ! $conflicts->{$installed->{'name'}} ) {
|
|
$conflicts->{$installed->{'name'}} = [];
|
|
}
|
|
|
|
push( @{$conflicts->{$installed->{'name'}}},
|
|
$file );
|
|
}
|
|
}
|
|
}
|
|
|
|
if ( keys( %$conflicts ) ) {
|
|
print STDERR "\nPackage $self->{'name'} conflicts with the"
|
|
. " following packages:\n\n";
|
|
|
|
foreach my $pkgname ( sort { $conflicts->{$a}{'name'} cmp
|
|
$conflicts->{$b}{'name'} } keys( %$conflicts ) ) {
|
|
print STDERR "[$pkgname]\n";
|
|
|
|
foreach my $file ( sort { $a cmp $b }
|
|
@{$conflicts->{$pkgname}} ) {
|
|
print " * $file\n";
|
|
}
|
|
|
|
print "\n";
|
|
}
|
|
|
|
Snap->error( -1, "Exiting due to conflicts" );
|
|
}
|
|
}
|
|
|
|
sub depends {
|
|
my $self = shift;
|
|
my $sources = shift;
|
|
my $dependencies = shift;
|
|
my $failures = shift;
|
|
my $selflist = shift;
|
|
|
|
if ( ! $failures ) {
|
|
$failures = [];
|
|
}
|
|
|
|
if ( ! $selflist ) {
|
|
$selflist = {};
|
|
}
|
|
|
|
if ( ! $selflist->{$self->{'name'}} ) {
|
|
$selflist->{$self->{'name'}} = $self;
|
|
}
|
|
else {
|
|
Snap->error( -1, "$self->{'name'}=$self->{'version'}:"
|
|
. " Package $selflist->{$self->{'name'}}="
|
|
. "$selflist->{$self->{'name'}}{'version'}"
|
|
. " already slated for installation" );
|
|
}
|
|
|
|
if ( $self->{'depends'} ) {
|
|
foreach my $depend ( split( ',', $self->{'depends'} ) ) {
|
|
my ( $name, $req ) = split( /(((<|>)=?|=)(.*))/,
|
|
$depend );
|
|
my $package;
|
|
|
|
if ( $self->{'name'} eq $name ) {
|
|
Snap->error( -1, "$self->{'name'}"
|
|
. "=$self->{'version'}:"
|
|
. " A package cannot be"
|
|
. " dependant on itself" );
|
|
}
|
|
|
|
if ( $selflist->{$name} && ( ! $req ||
|
|
Snap->chkreq( $req,
|
|
$selflist->{$name}{'version'} ) ) ) {
|
|
next;
|
|
}
|
|
elsif ( $sources->{'installed'}{$name} && ( ! $req ||
|
|
Snap->chkreq( $req,
|
|
$sources->{'installed'}{$name}{'version'} ) ) ) {
|
|
next;
|
|
}
|
|
|
|
$package = $sources->search( {
|
|
quiet => 1,
|
|
name => $name,
|
|
version => $req
|
|
} );
|
|
|
|
if ( ! $package ) {
|
|
push( @$failures, "$depend" );
|
|
|
|
next;
|
|
}
|
|
|
|
if ( ( grep { $_->{'name'} eq $package->{'name'} }
|
|
@$dependencies ) || $package->installed() ) {
|
|
next;
|
|
}
|
|
|
|
$package->depends( $sources, $dependencies,
|
|
$failures, $selflist );
|
|
|
|
push( @$dependencies, $package );
|
|
}
|
|
}
|
|
|
|
if ( @$failures ) {
|
|
print STDERR "Failed to resolve dependencies\n";
|
|
|
|
Snap->error( -1, "depends(): unresolved dependencies: "
|
|
. join( ",", @$failures ) );
|
|
}
|
|
|
|
$self->revdeps( $sources, $dependencies );
|
|
}
|
|
|
|
sub dump {
|
|
my $self = shift;
|
|
my $pid;
|
|
my $sel;
|
|
my $cnt;
|
|
my $stderr;
|
|
my $stat;
|
|
local $| = 1;
|
|
|
|
if ( $self->{'path'} =~ /^https*:\/\// ) {
|
|
( my $filename = $self->{'path'} ) =~ s/.*\///;
|
|
|
|
Snap->httpget( $self->{'path'}, Snap->PKGDIR
|
|
. "/$filename", 0644 );
|
|
|
|
$self->{'path'} = Snap->PKGDIR . "/$filename";
|
|
}
|
|
|
|
print "Dumping $self->{'name'}=$self->{'version'}\n";
|
|
|
|
print "\e[?25l\r";
|
|
|
|
eval {
|
|
my $target = Snap->TARGET ||
|
|
"$self->{'name'}-$self->{'version'}";
|
|
|
|
if ( ! -d $target ) {
|
|
mkdir( $target );
|
|
}
|
|
|
|
$pid = open3( \*CHLDIN, \*CHLDOUT, \*CHLDERR,
|
|
"/usr/bin/ar p $self->{'path'} files.tar.gz|"
|
|
. "tar --no-overwrite-dir --keep-directory-symlink"
|
|
. " -hzvxf - -C $target" );
|
|
} || Snap->error( int( $! ), "open3(): /usr/bin/ar: $!" );
|
|
|
|
close( CHLDIN );
|
|
|
|
$sel = IO::Select->new();
|
|
$sel->add( *CHLDOUT, *CHLDERR );
|
|
|
|
while ( my @fhs = $sel->can_read ) {
|
|
foreach my $fh ( @fhs ) {
|
|
if ( eof( $fh ) ) {
|
|
$sel->remove( $fh );
|
|
|
|
next;
|
|
}
|
|
|
|
if ( fileno( $fh ) == fileno( *CHLDOUT ) ) {
|
|
my $line = <$fh>;
|
|
( my $file = $line ) =~ s/.*\/|\n$//;
|
|
chomp( $line );
|
|
chomp( $file );
|
|
|
|
if ( $file ) {
|
|
$cnt++;
|
|
|
|
print "\e[K$file\r";
|
|
}
|
|
}
|
|
elsif ( fileno( $fh ) == fileno( *CHLDERR ) ) {
|
|
$stderr .= <$fh>;
|
|
}
|
|
}
|
|
}
|
|
|
|
close( CHLDOUT );
|
|
close( CHLDERR );
|
|
|
|
waitpid( $pid, 0 );
|
|
$stat = $? >> 8;
|
|
|
|
if ( $stat ) {
|
|
Snap->error( $stat, "Failed dumping $self->{'name'}:"
|
|
. " $stderr\e[?25h" );
|
|
}
|
|
|
|
print "\e[K$cnt files extracted\e[?25h\n";
|
|
}
|
|
|
|
sub files {
|
|
my $self = shift;
|
|
my $opts = shift;
|
|
my $manifestfile = Snap->INSTDIR . "/$self->{'name'}/manifest";
|
|
$self->{'files'} = [];
|
|
|
|
if ( $self->{'path'} && -f $self->{'path'} ) {
|
|
my $sel = IO::Select->new();
|
|
my $stdout;
|
|
my $stderr;
|
|
my $stat;
|
|
my $pid;
|
|
|
|
eval {
|
|
$pid = open3( \*CHLDIN, \*CHLDOUT, \*CHLDERR,
|
|
"/usr/bin/ar p $self->{'path'} manifest" );
|
|
} || Snap->error( int( $! ), "open3(): /usr/bin/ar:"
|
|
. " $!" );
|
|
|
|
close( CHLDIN );
|
|
|
|
$sel->add( *CHLDOUT, *CHLDERR );
|
|
|
|
while ( my @fhs = $sel->can_read ) {
|
|
foreach my $fh ( @fhs ) {
|
|
if ( eof( $fh ) ) {
|
|
$sel->remove( $fh );
|
|
|
|
next;
|
|
}
|
|
|
|
if ( fileno( $fh ) == fileno( *CHLDOUT ) ) {
|
|
my ( $sha, $perms, $file ) =
|
|
split( /\s+/, <$fh> );
|
|
|
|
if ( ! $opts->{'all'} &&
|
|
$perms =~ /^d/ ) {
|
|
next;
|
|
}
|
|
|
|
if ( $opts->{'quiet'} &&
|
|
$opts->{'verbose'} ) {
|
|
push( @{$self->{'files'}}, [
|
|
$sha, $perms, $file ] );
|
|
}
|
|
elsif ( $opts->{'quiet'} ) {
|
|
push( @{$self->{'files'}},
|
|
$file );
|
|
}
|
|
elsif ( $opts->{'verbose'} ) {
|
|
print "$sha\t$perms\t$file\n";
|
|
}
|
|
else {
|
|
print "$file\n";
|
|
}
|
|
}
|
|
elsif ( fileno( $fh ) == fileno( *CHLDERR ) ) {
|
|
$stderr .= <$fh>;
|
|
}
|
|
}
|
|
}
|
|
|
|
close( CHLDOUT );
|
|
close( CHLDERR );
|
|
|
|
waitpid( $pid, 0 );
|
|
$stat = $? >> 8;
|
|
|
|
if ( $stat || $stderr ) {
|
|
$stderr =~ s/.*: //;
|
|
|
|
if ( ! $stat ) {
|
|
$stat = -1;
|
|
}
|
|
|
|
Snap->error( $stat, "Failed reading '$self->{'path'}':"
|
|
. " $stderr" );
|
|
}
|
|
}
|
|
elsif ( -f $manifestfile ) {
|
|
open( MANIFEST, "<$manifestfile" ) ||
|
|
Snap->error( int( $! ), "open(): $manifestfile: $!" );
|
|
|
|
while ( <MANIFEST> ) {
|
|
my ( $sha, $perms, $file ) = split( /\s+/, $_ );
|
|
|
|
if ( ! $opts->{'all'} && $perms =~ /^d/ ) {
|
|
next;
|
|
}
|
|
|
|
if ( $opts->{'quiet'} ) {
|
|
if ( ! $self->{'files'} ) {
|
|
$self->{'files'} = [];
|
|
}
|
|
|
|
if ( $opts->{'verbose'} ) {
|
|
push( @{$self->{'files'}}, [
|
|
$sha, $perms, $file ] );
|
|
}
|
|
else {
|
|
push( @{$self->{'files'}}, $file );
|
|
}
|
|
}
|
|
elsif ( $opts->{'verbose'} ) {
|
|
print "$sha\t$perms\t$file\n";
|
|
}
|
|
else {
|
|
print "$file\n";
|
|
}
|
|
}
|
|
|
|
close( MANIFEST ) ||
|
|
Snap->error( int( $! ), "open(): $manifestfile: $!" );
|
|
}
|
|
else {
|
|
Snap->error( -2, "'$self->{'name'}':"
|
|
. " No such file or package installed" );
|
|
}
|
|
}
|
|
|
|
############################################################
|
|
#
|
|
# This just generates the dir directory file for info docs
|
|
#
|
|
############################################################
|
|
|
|
sub infodir {
|
|
my $self = shift;
|
|
my $infodir = Snap->TARGET . '/usr/share/info';
|
|
my $infofiles = [];
|
|
|
|
if ( ! @{$self->{'files'}} ) {
|
|
return();
|
|
}
|
|
|
|
foreach my $file ( sort( @{$self->{'files'}} ) ) {
|
|
if ( $file !~ /usr\/share\/info\/.*\.info*/ ||
|
|
! -f Snap->TARGET . "/$file" ) {
|
|
next;
|
|
}
|
|
|
|
push( @$infofiles, Snap->TARGET . "/$file" );
|
|
}
|
|
|
|
if ( @$infofiles == 0 ) {
|
|
return();
|
|
}
|
|
|
|
print "Updating " . @$infofiles . " info/dir entries\n";
|
|
|
|
print "\e[?25l\r";
|
|
|
|
foreach my $file ( @$infofiles ) {
|
|
my $sel = IO::Select->new();
|
|
my $stdout;
|
|
my $stderr;
|
|
my $stat;
|
|
my $pid;
|
|
|
|
print "\e[K$file\r";
|
|
|
|
eval {
|
|
$pid = open3( \*CHLDIN, \*CHLDOUT, \*CHLDERR,
|
|
"install-info $file $infodir/dir" );
|
|
} || Snap->error( 0, 'install-info failed' );
|
|
|
|
close( CHLDIN );
|
|
|
|
$sel->add( *CHLDOUT, *CHLDERR );
|
|
|
|
while ( my @fhs = $sel->can_read ) {
|
|
foreach my $fh ( @fhs ) {
|
|
if ( eof( $fh ) ) {
|
|
$sel->remove( $fh );
|
|
|
|
next;
|
|
}
|
|
|
|
if ( fileno( $fh ) == fileno( *CHLDOUT ) ) {
|
|
$stdout .= <$fh>;
|
|
}
|
|
elsif ( fileno( $fh ) == fileno( *CHLDERR ) ) {
|
|
$stderr .= <$fh>;
|
|
}
|
|
}
|
|
}
|
|
|
|
close( CHLDOUT );
|
|
close( CHLDERR );
|
|
|
|
waitpid( $pid, 0 );
|
|
$stat = $? >> 8;
|
|
|
|
if ( $? ) {
|
|
Snap->error( 0, "install-info: $file: $stderr" );
|
|
}
|
|
}
|
|
|
|
print "\e[Kdone\e[?25h\r";
|
|
}
|
|
|
|
sub install {
|
|
my $self = shift;
|
|
my $sources = shift;
|
|
my $pkgdir = Snap->INSTDIR . "/$self->{'name'}";
|
|
my $snapinfo = "$pkgdir/snapinfo";
|
|
my $manifest = "$pkgdir/manifest";
|
|
my $oldpkg;
|
|
my $pid;
|
|
my $sel;
|
|
my $cnt;
|
|
my $libcnt;
|
|
my $stderr;
|
|
my $stat;
|
|
local $| = 1;
|
|
|
|
####################################################
|
|
#
|
|
# This should attempt to get an exclusive lock on
|
|
# a temporary lock file. If it fails lock() will
|
|
# assume this means that a snap process is already
|
|
# running and die.
|
|
#
|
|
####################################################
|
|
|
|
Snap->lock();
|
|
|
|
$ENV{'VERSION'} = $self->{'version'};
|
|
|
|
if ( ! -f $self->{'path'} ) {
|
|
Snap->error( -1, "install(): $self->{'path'}:"
|
|
. " No such file or directory" );
|
|
}
|
|
|
|
if ( $self->{'path'} =~ /^https*:\/\// ) {
|
|
( my $filename = $self->{'path'} ) =~ s/.*\///;
|
|
|
|
Snap->httpget( $self->{'path'}, Snap->PKGDIR
|
|
. "/$filename", 0644 );
|
|
|
|
$self->{'path'} = Snap->PKGDIR . "/$filename";
|
|
}
|
|
|
|
if ( ! -d $pkgdir ) {
|
|
mkdir( $pkgdir, 0755 ) ||
|
|
Snap->error( int( $! ), "mkdir(): $pkgdir: $!" );
|
|
}
|
|
|
|
####################################################
|
|
#
|
|
# If a different version of this package is
|
|
# installed we need to capture the file list from
|
|
# the old manifest file so that any files which are
|
|
# no longer a part of the package are cleaned up
|
|
# after installing the new version.
|
|
#
|
|
# We also move the old snapinfo and manifest to
|
|
# temporary files which are cleaned up after the
|
|
# new package is successfully installed. Holding
|
|
# on to these things until after we're sure the
|
|
# install was successful is not a bad idea...
|
|
#
|
|
####################################################
|
|
|
|
if ( $sources->{'installed'}{$self->{'name'}} ) {
|
|
$oldpkg = $sources->{'installed'}{$self->{'name'}};
|
|
|
|
rename( $snapinfo, "$snapinfo.$oldpkg->{'version'}" ) ||
|
|
Snap->error( int( $! ), "rename(): $snapinfo: $!" );
|
|
rename( $manifest, "$manifest.$oldpkg->{'version'}" ) ||
|
|
Snap->error( int( $! ), "rename(): $manifest: $!" );
|
|
}
|
|
|
|
print "Installing $self->{'name'}=$self->{'version'}\n";
|
|
|
|
$self->usher( 'preinst' );
|
|
|
|
print "\e[?25l\r";
|
|
|
|
eval {
|
|
my $target = Snap->TARGET || '/';
|
|
|
|
$pid = open3( \*CHLDIN, \*CHLDOUT, \*CHLDERR,
|
|
"/usr/bin/ar p $self->{'path'} files.tar.gz|"
|
|
. "tar --no-overwrite-dir --keep-directory-symlink"
|
|
. " -hzvxf - -C $target" );
|
|
} || Snap->error( int( $! ), "open3(): /usr/bin/ar: $!" );
|
|
|
|
close( CHLDIN );
|
|
|
|
$sel = IO::Select->new();
|
|
$sel->add( *CHLDOUT, *CHLDERR );
|
|
|
|
while ( my @fhs = $sel->can_read ) {
|
|
foreach my $fh ( @fhs ) {
|
|
if ( eof( $fh ) ) {
|
|
$sel->remove( $fh );
|
|
|
|
next;
|
|
}
|
|
|
|
if ( fileno( $fh ) == fileno( *CHLDOUT ) ) {
|
|
my $line = <$fh>;
|
|
( my $file = $line ) =~ s/.*\/|\n$//;
|
|
chomp( $line );
|
|
chomp( $file );
|
|
|
|
if ( $oldpkg ) {
|
|
$oldpkg->{'files'} = [
|
|
grep( $_ ne $line,
|
|
@{$oldpkg->{'files'}} )
|
|
];
|
|
}
|
|
|
|
if ( $file ) {
|
|
$cnt++;
|
|
|
|
print "\e[K$file\r";
|
|
}
|
|
}
|
|
elsif ( fileno( $fh ) == fileno( *CHLDERR ) ) {
|
|
$stderr .= <$fh>;
|
|
}
|
|
}
|
|
}
|
|
|
|
close( CHLDOUT );
|
|
close( CHLDERR );
|
|
|
|
waitpid( $pid, 0 );
|
|
$stat = $? >> 8;
|
|
|
|
if ( $stat ) {
|
|
Snap->error( $stat, "Failed installing $self->{'name'}:"
|
|
. " $stderr\e[?25h" );
|
|
}
|
|
|
|
print "\e[K$cnt files extracted\e[?25h\n";
|
|
|
|
if ( $oldpkg ) {
|
|
foreach ( @{$oldpkg->{'files'}} ) {
|
|
if ( -f Snap->TARGET . "/$_" ) {
|
|
unlink( Snap->TARGET . "/$_" ) ||
|
|
Snap->error( int( $? ), "unlink(): "
|
|
. Snap->TARGET
|
|
. "/$_: $!\e[?25h" );
|
|
}
|
|
}
|
|
}
|
|
|
|
$self->usher( 'postinst' );
|
|
|
|
open( AR, "ar p $self->{'path'} manifest|" ) ||
|
|
Snap->error( int( $! ), "open(): $self->{'path'}: $!" );
|
|
sysopen( MANIFEST, $manifest, O_RDWR|O_TRUNC|O_CREAT, 0644 ) ||
|
|
Snap->error( int( $! ), "sysopen(): $manifest: $!" );
|
|
|
|
while ( <AR> ) {
|
|
print MANIFEST $_;
|
|
}
|
|
|
|
close( MANIFEST ) || Snap->error( int( $! ),
|
|
"sysopen(): $manifest: $!" );
|
|
close( AR ) || Snap->error( int( $! ), "open(): $manifest: $!" );
|
|
|
|
open( AR, "ar p $self->{'path'} snapinfo|" ) ||
|
|
Snap->error( int( $! ), "open(): $self->{'path'}: $!" );
|
|
sysopen( SNAPINFO, $snapinfo, O_RDWR|O_TRUNC|O_CREAT, 0644 ) ||
|
|
Snap->error( int( $! ), "sysopen(): $snapinfo: $!" );
|
|
|
|
while ( <AR> ) {
|
|
print SNAPINFO $_;
|
|
}
|
|
|
|
close( SNAPINFO ) || Snap->error( int( $! ),
|
|
"sysopen(): $snapinfo: $!" );
|
|
close( AR ) || Snap->error( int( $! ), "open(): $self->{'path'}: $!" );
|
|
|
|
if ( $oldpkg ) {
|
|
unlink( "$snapinfo.$oldpkg->{'version'}" ) ||
|
|
Snap->error( int( $! ), "unlink(): $snapinfo: $!" );
|
|
unlink( "$manifest.$oldpkg->{'version'}" ) ||
|
|
Snap->error( int( $! ), "unlink(): $manifest: $!" );
|
|
}
|
|
|
|
$self->infodir();
|
|
|
|
Snap->unlock();
|
|
|
|
print "Finished installing $self->{'name'}\n";
|
|
}
|
|
|
|
sub installed {
|
|
my $self = shift;
|
|
my $infofile;
|
|
|
|
if ( ref( $self ) ) {
|
|
$infofile = Snap->INSTDIR . "/$self->{'name'}/snapinfo";
|
|
}
|
|
else {
|
|
$infofile = Snap->INSTDIR . "/$self/snapinfo";
|
|
}
|
|
|
|
if ( ref( $self ) && -f $infofile ) {
|
|
my $snapinfo;
|
|
|
|
open( SNAPINFO, "<$infofile" ) ||
|
|
Snap->error( int( $! ), "open: $!" );
|
|
|
|
while ( <SNAPINFO> ) {
|
|
if ( $_ =~ /^(\S+)\s*:\s*(.*)$/ ) {
|
|
$snapinfo->{$1} = $2;
|
|
}
|
|
}
|
|
|
|
close( SNAPINFO ) ||
|
|
Snap->error( int( $! ), "open: $!" );
|
|
|
|
if ( $self->{'name'} eq $snapinfo->{'name'} &&
|
|
$self->{'version'} eq $snapinfo->{'version'} ) {
|
|
return( 1 );
|
|
}
|
|
}
|
|
elsif ( -f $infofile ) {
|
|
return( 1 );
|
|
}
|
|
|
|
return( 0 );
|
|
}
|
|
|
|
sub printbrief {
|
|
my $self = shift;
|
|
|
|
if ( -t STDOUT ) {
|
|
printf( '%-16.16s ', $self->{'name'} );
|
|
printf( '%-10.10s ', $self->{'version'} );
|
|
printf( '%.52s', $self->{'brief'} || $self->{'description'} );
|
|
}
|
|
else {
|
|
printf( '%-30.30s', $self->{'name'} );
|
|
printf( '%-20.20s', $self->{'version'} );
|
|
print $self->{'brief'} || $self->{'description'};
|
|
}
|
|
|
|
print "\n";
|
|
}
|
|
|
|
sub printself {
|
|
my $self = shift;
|
|
|
|
foreach my $field ( FIELDS ) {
|
|
if ( $self->{$field} ) {
|
|
print "$field: $self->{$field}\n";
|
|
}
|
|
}
|
|
}
|
|
|
|
sub remove {
|
|
my $self = shift;
|
|
my $pkgdir = Snap->INSTDIR . "/$self->{'name'}";
|
|
my $snapinfo = "$pkgdir/snapinfo";
|
|
my $manifest = "$pkgdir/manifest";
|
|
my $usher = "$pkgdir/usher";
|
|
my $cnt = 0;
|
|
|
|
Snap->lock();
|
|
|
|
$self->files( { quiet => 1, all => 1 } );
|
|
|
|
print "Removing $self->{'name'}=$self->{'version'}\n";
|
|
|
|
$self->usher( 'prerm' );
|
|
|
|
print "\e[?25l\r";
|
|
|
|
foreach ( @{$self->{'files'}} ) {
|
|
if ( -f Snap->TARGET . "/$_" ) {
|
|
unlink( Snap->TARGET . "/$_" ) || Snap->error(
|
|
int( $! ), "unlink(): " . Snap->TARGET
|
|
. "/$_: $!" );
|
|
|
|
print "\e[K$_\r";
|
|
|
|
$cnt++;
|
|
}
|
|
}
|
|
|
|
$self->usher( 'postrm' );
|
|
|
|
unlink( $manifest ) || Snap->error( int( $! ), "unlink():"
|
|
. " $manifest: $!" );
|
|
unlink( $snapinfo ) || Snap->error( int( $! ), "unlink():"
|
|
. " $snapinfo: $!" );
|
|
|
|
if ( -f $usher ) {
|
|
unlink( $usher ) || Snap->error( int( $! ), "unlink():"
|
|
. " $usher: $!" );
|
|
}
|
|
|
|
print "\e[K$cnt files removed\e[?25h\n";
|
|
|
|
Snap->unlock();
|
|
|
|
print "Finished removing $self->{'name'}\n";
|
|
}
|
|
|
|
sub revdeps {
|
|
my $self = shift;
|
|
my $sources = shift;
|
|
my $revdeps = shift;
|
|
my $opts = shift;
|
|
|
|
foreach my $pkgname ( keys( %{$sources->{'installed'}} ) ) {
|
|
if ( $self->{'name'} eq $pkgname ) {
|
|
next;
|
|
}
|
|
|
|
my $package = $sources->{'installed'}{$pkgname};
|
|
my $chgver = 0;
|
|
|
|
foreach my $depend ( split( /,/, $package->{'depends'} ) ) {
|
|
my ( $name, $req ) = split( /(((<|>)=?|=)(.*))/,
|
|
$depend );
|
|
|
|
if ( $self->{'name'} ne $name ) {
|
|
next;
|
|
}
|
|
elsif ( $opts->{'noreq'} && ! grep( $_->{'name'} eq
|
|
$package->{'name'}, @$revdeps ) ) {
|
|
$package->revdeps( $sources, $revdeps );
|
|
push( @$revdeps, $package );
|
|
|
|
last;
|
|
}
|
|
elsif ( ! $req || grep( $_->{'name'} eq
|
|
$package->{'name'}, @$revdeps ) ||
|
|
Snap->chkreq( $req, $self->{'version'} ) ) {
|
|
last;
|
|
}
|
|
|
|
$chgver++;
|
|
|
|
last;
|
|
}
|
|
|
|
if ( ! $chgver ) {
|
|
next;
|
|
}
|
|
|
|
foreach my $newpkg ( sort { Snap->vercmp( $a->{'version'},
|
|
$b->{'version'} ) } @{$sources->{'pkgs'}{$pkgname}} ) {
|
|
foreach my $depend ( split( /,/,
|
|
$newpkg->{'depends'} ) ) {
|
|
my ( $name, $req ) = split( /(((<|>)=?|=)(.*))/,
|
|
$depend );
|
|
|
|
if ( $self->{'name'} ne $name ) {
|
|
next;
|
|
}
|
|
elsif ( ! $req || Snap->chkreq( $req,
|
|
$self->{'version'} ) ) {
|
|
$chgver = 0;
|
|
|
|
last;
|
|
}
|
|
}
|
|
|
|
if ( ! $chgver ) {
|
|
$newpkg->revdeps( $sources, $revdeps );
|
|
push( @$revdeps, $newpkg );
|
|
|
|
last;
|
|
}
|
|
}
|
|
|
|
if ( $chgver ) {
|
|
Snap->error( -1, "revdep(): Unable to find a version"
|
|
. " of $pkgname that is satisfied with"
|
|
. " $self->{'name'}=$self->{'version'}\n" );
|
|
}
|
|
}
|
|
}
|
|
|
|
sub usher {
|
|
my $self = shift;
|
|
my $action = shift;
|
|
my $usher = Snap->INSTDIR . "/$self->{'name'}/usher";
|
|
my $pid;
|
|
my $sel;
|
|
my $stderr;
|
|
my $stat;
|
|
|
|
if ( $action eq 'preinst' ) {
|
|
my $cnt = 0;
|
|
|
|
eval {
|
|
$pid = open3( \*CHLDIN, \*CHLDOUT, \*CHLDERR,
|
|
"/usr/bin/ar p $self->{'path'} usher" );
|
|
} || Snap->error( int( $! ), "open3():"
|
|
. " /usr/bin/ar: $!" );
|
|
|
|
close( CHLDIN );
|
|
|
|
$sel = IO::Select->new();
|
|
$sel->add( *CHLDOUT, *CHLDERR );
|
|
|
|
sysopen( USHER, $usher, O_RDWR|O_TRUNC|O_CREAT, 0755 ) ||
|
|
Snap->error( int( $! ), "sysopen(): $usher: $!" );
|
|
|
|
while ( my @fhs = $sel->can_read ) {
|
|
foreach my $fh ( @fhs ) {
|
|
if ( eof( $fh ) ) {
|
|
$sel->remove( $fh );
|
|
|
|
next;
|
|
}
|
|
|
|
if ( fileno( $fh ) == fileno( *CHLDOUT ) ) {
|
|
my $line = <$fh>;
|
|
|
|
print USHER $line;
|
|
|
|
$cnt++;
|
|
}
|
|
elsif ( fileno( $fh ) == fileno( *CHLDERR ) ) {
|
|
$stderr .= <$fh>;
|
|
|
|
if ( $stderr =~ /^no entry usher/ ) {
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
close( CHLDOUT );
|
|
close( CHLDERR );
|
|
close( USHER );
|
|
|
|
waitpid( $pid, 0 );
|
|
$stat = $? >> 8;
|
|
|
|
if ( $stat ) {
|
|
Snap->error( $stat, "Failed $self->{'name'}:"
|
|
. " $stderr\e[?25h" );
|
|
}
|
|
|
|
if ( ! $cnt && -f $usher ) {
|
|
unlink( $usher );
|
|
|
|
return;
|
|
}
|
|
}
|
|
|
|
####################################################
|
|
#
|
|
# The usher script is forked and execed as a child
|
|
# process. For most packages the process will be
|
|
# executed in a chroot environment if a TARGET has
|
|
# been specified.
|
|
#
|
|
# The presence of coreutils should indicate an
|
|
# environment in which a chroot would be successful.
|
|
# We also check for bash or dash since usher
|
|
# should always be a shell script. This should be
|
|
# reduced to only checking for dash in the future
|
|
# since the intention is for all usher scripts
|
|
# to use /bin/sh which is expected to be dash.
|
|
#
|
|
# Certain packages (such as glibc) need to be able
|
|
# to execute usher without a chroot if a full
|
|
# environment is unavailable.
|
|
#
|
|
# For non-root users a fake chroot environment is
|
|
# created (if fakeroot and fakechroot is present).
|
|
#
|
|
# There is a bit of a hack here to undef TARGET
|
|
# so that usher scripts which still attempt to
|
|
# perform a chroot will not do so.
|
|
#
|
|
####################################################
|
|
|
|
if ( ! -f $usher ) {
|
|
return;
|
|
}
|
|
|
|
if ( $pid = fork() ) {
|
|
waitpid( $pid, 0 );
|
|
$stat = $? >> 8;
|
|
}
|
|
elsif ( Snap->TARGET && installed( 'coreutils' ) &&
|
|
installed( 'dash' ) ) {
|
|
my $cmd;
|
|
$usher = substr( $usher, length( Snap->TARGET ) );
|
|
undef( $ENV{'TARGET'} );
|
|
|
|
if ( $> ) {
|
|
$ENV{'PATH'} = "$ENV{'PATH'}:/sbin:/usr/sbin";
|
|
$cmd = "fakeroot fakechroot /usr/sbin/chroot "
|
|
. Snap->TARGET . " $usher $action";
|
|
}
|
|
else {
|
|
chroot( Snap->TARGET );
|
|
chdir( '/' );
|
|
$cmd = "$usher $action";
|
|
}
|
|
|
|
exec( $cmd );
|
|
}
|
|
else {
|
|
exec( "$usher $action" );
|
|
}
|
|
|
|
if ( $stat ) {
|
|
Snap->error( $stat, "usher(): Failed executing usher" );
|
|
}
|
|
}
|
|
|
|
############################################################
|
|
#
|
|
# Might want to modify this... it doesn't currently work
|
|
# because the first shift gives you the class due to the
|
|
# fact that it must be called while specifying the namespace
|
|
#
|
|
# It has been modded on the central server only for now...
|
|
#
|
|
############################################################
|
|
|
|
sub sha256 {
|
|
my $pkgfile = shift;
|
|
my $digest = eval {
|
|
Digest::SHA->new( 256 )->addfile( $pkgfile );
|
|
} || Snap->error( int( $! ), "sha256(): $pkgfile: $!" );
|
|
|
|
return( $digest->hexdigest );
|
|
}
|
|
|
|
sub source {
|
|
my $self = shift;
|
|
my $gitcmd = "git clone git://git.snaplinux.org/$self->{'srcpkg'}.git";
|
|
my $sel = IO::Select->new();
|
|
my $stat;
|
|
my $pid;
|
|
|
|
if ( $pid = fork() ) {
|
|
waitpid( $pid, 0 );
|
|
$stat = $? >> 8;
|
|
}
|
|
else {
|
|
exec( $gitcmd );
|
|
}
|
|
|
|
if ( $stat ) {
|
|
Snap->error( $stat, "Failed to clone $self->{'srcpkg'}" );
|
|
}
|
|
|
|
if ( $pid = fork() ) {
|
|
waitpid( $pid, 0 );
|
|
$stat = $? >> 8;
|
|
}
|
|
else {
|
|
chdir( $self->{'srcpkg'} );
|
|
exec( "git checkout v$self->{'version'}" );
|
|
}
|
|
}
|
|
|
|
1;
|