commit d00d644fd5a79b52b8adc582aaefa9b36fec72ba Author: Jay Larson Date: Mon Oct 24 06:24:10 2016 -0500 First check in diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..d9d68c4 --- /dev/null +++ b/Makefile @@ -0,0 +1,41 @@ +# This file is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License version 2 as +# published by the Free Software Foundation here: +# (http://www.gnu.org/licenses/gpl-2.0.html) +# +# 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. + +DEPENDS = bash,binutils,coreutils,gzip,perl,shadow,tar +ARCH = x86_64 +URL = +DESC = This is the base of the snaplinux system +SNAPVER = sr0 + +ARCHIVE := '' +SRCDIR := $(PWD)/SRC/snap-* +PATCHDIR := $(PWD)/SRC/patches +VERSION := $(shell echo $(SRCDIR)|egrep -o '\-[0-9].*'|sed 's/^-//')$(SNAPVER) + +MAKEINST = make install + +include /usr/share/snap/Makefile.snaplinux + +$(ROOT): $(SRCDIR)/Makefile + @if [ -d $(ROOT) ]; then \ + touch $(ROOT); \ + else \ + mkdir -v $(ROOT); \ + fi + + @cd $(SRCDIR); \ + $(MAKEINST) DESTDIR=$(ROOT) + +clean: + @rm -rvf $(ROOT) \ + $(SNAPINFO) \ + $(MANIFEST) \ + $(FILES) + diff --git a/SNAP/README b/SNAP/README new file mode 100644 index 0000000..19a3ff1 --- /dev/null +++ b/SNAP/README @@ -0,0 +1,3 @@ +This is the directory where the manifest, snapinfo, and files.tar.gz +files will be created. It is also where the usher file should be +placed if it is required by the package. diff --git a/SNAP/usher b/SNAP/usher new file mode 100755 index 0000000..d466f86 --- /dev/null +++ b/SNAP/usher @@ -0,0 +1,108 @@ +#!/bin/bash + +set -e + +PASSWD="root:x:0:0:root:/root:/bin/bash +bin:x:1:1:bin:/dev/null:/bin/false +daemon:x:6:6:Daemon User:/dev/null:/bin/false +messagebus:x:18:18:D-Bus Message Daemon User:/var/run/dbus:/bin/false +nobody:x:99:99:Unprivileged User:/dev/null:/bin/false" + +GROUP="root:x:0: +bin:x:1:daemon +sys:x:2: +kmem:x:3: +tape:x:4: +tty:x:5: +daemon:x:6: +floppy:x:7: +disk:x:8: +lp:x:9: +dialout:x:10: +audio:x:11: +video:x:12: +utmp:x:13: +usb:x:14: +cdrom:x:15: +adm:x:16: +messagebus:x:18: +input:x:24: +mail:x:34: +nogroup:x:99: +users:x:999:" + +case $1 in + preinst) + echo "Creating base directory structure" + install -d -m 755 ${TARGET}/etc/{ld.so,conf.d,opt} + install -d -m 755 ${TARGET}/usr/bin + install -d -m 755 ${TARGET}/bin + install -d -m 755 ${TARGET}/boot + install -d -m 755 ${TARGET}/dev + install -d -m 755 ${TARGET}/home + install -d -m 755 ${TARGET}/lib + install -d -m 755 ${TARGET}/media/{cdrom,floppy} + install -d -m 755 ${TARGET}/mnt + install -d -m 755 ${TARGET}/opt + install -d -m 755 ${TARGET}/proc + install -d -m 750 ${TARGET}/root + install -d -m 755 ${TARGET}/run/lock + install -d -m 755 ${TARGET}/sbin + install -d -m 755 ${TARGET}/srv + install -d -m 755 ${TARGET}/sys + install -d -m 1777 ${TARGET}/tmp + install -d -m 755 ${TARGET}/usr/{bin,include,lib,libexec,local} + install -d -m 755 ${TARGET}/usr/local/{bin,include,lib,sbin,share} + install -d -m 755 \ + ${TARGET}/usr/local/share/{color,dict,doc,info,locale,man} + install -d -m 755 ${TARGET}/usr/local/share/man/man{1..8} + install -d -m 755 ${TARGET}/usr/local/share/{misc,terminfo,zoneinfo} + install -d -m 755 ${TARGET}/usr/local/src + install -d -m 755 ${TARGET}/usr/{sbin,share} + install -d -m 755 ${TARGET}/usr/share/{color,dict,doc,info,locale} + install -d -m 755 ${TARGET}/usr/share/man/man{1..8} + install -d -m 755 ${TARGET}/usr/share/{misc,snap,terminfo,zoneinfo} + install -d -m 755 ${TARGET}/usr/src + install -d -m 755 ${TARGET}/var/cache/nscd + install -d -m 755 ${TARGET}/var/lib/{color,locate,misc} + install -d -m 755 ${TARGET}/var/{local,log,mail,opt,snap,spool} + install -d -m 1777 ${TARGET}/var/tmp + install -m 600 /dev/null ${TARGET}/var/log/btmp + install -m 644 /dev/null ${TARGET}/var/log/wtmp + install -m 664 /dev/null ${TARGET}/var/log/lastlog + ln -sf /proc/self/mounts ${TARGET}/etc/mtab + ln -sf lib ${TARGET}/lib64 + ln -sf lib ${TARGET}/usr/lib64 + ln -sf lib ${TARGET}/usr/local/lib64 + ln -sf /run/lock ${TARGET}/var/lock + ln -sf /run ${TARGET}/var/run + + if [ ! -f ${TARGET}/etc/resolv.conf ]&&[ -f /etc/resolv.conf ]; then + echo "Copying resolv.conf from temporary system" + cp /etc/resolv.conf ${TARGET}/etc/resolv.conf + fi + + if [ ! -f ${TARGET}/etc/passwd ]; then + echo "Creating /etc/passwd" + echo ${PASSWD} > ${TARGET}/etc/passwd + fi + + if [ ! -f ${TARGET}/etc/group ]; then + echo "Creating /etc/group" + echo ${GROUP} > ${TARGET}/etc/group + fi + ;; + postinst) + if [[ ${TARGET} ]]; then + echo "Refreshing snap" + chroot ${TARGET} snap refresh + fi + exit 0 + ;; + prerm) + exit 0 + ;; + postrm) + exit 0 + ;; +esac diff --git a/SRC/patches/README b/SRC/patches/README new file mode 100644 index 0000000..253cdcd --- /dev/null +++ b/SRC/patches/README @@ -0,0 +1,2 @@ +Place any patch files here and preface each with a number indicating +the order of execution. Patch files are expected to use a .patch extension. diff --git a/SRC/snap-0.0/Makefile b/SRC/snap-0.0/Makefile new file mode 100644 index 0000000..19c7824 --- /dev/null +++ b/SRC/snap-0.0/Makefile @@ -0,0 +1,12 @@ +dirs: + install -d -v -m 755 $(DESTDIR)/etc + install -d -v -m 755 $(DESTDIR)/usr/{bin,share/snap} + +files: + install -v -m 644 snap_version $(DESTDIR)/etc/snap_version + install -v -m 644 snap.conf $(DESTDIR)/etc/snap.conf + install -v -m 755 snap $(DESTDIR)/usr/bin/snap + install -v -m 644 Makefile.snaplinux \ + $(DESTDIR)/usr/share/snap/Makefile.snaplinux + +install: dirs files diff --git a/SRC/snap-0.0/Makefile.snaplinux b/SRC/snap-0.0/Makefile.snaplinux new file mode 100644 index 0000000..b44d104 --- /dev/null +++ b/SRC/snap-0.0/Makefile.snaplinux @@ -0,0 +1,95 @@ +# This file is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License version 2 as +# published by the Free Software Foundation here: +# (http://www.gnu.org/licenses/gpl-2.0.html) +# +# 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. + +PWD := $(shell pwd) +PACKAGE := $(shell echo $(PWD)|sed 's/.*\///') +SNAPDIR = $(PWD)/SNAP +ROOT = $(PWD)/ROOT + +BYTES = 0 +SNAP = $(PACKAGE)-$(VERSION).snap +SNAPINFO = $(SNAPDIR)/snapinfo +MANIFEST = $(SNAPDIR)/manifest +USHER = $(SNAPDIR)/usher +FILES = $(SNAPDIR)/files.tar.gz + +# The following values must be set in the Makefile for the package + +ifndef ARCHIVE +$(error ARCHIVE is not set) +endif + +ifndef SRCDIR +$(error SRCDIR is not set) +endif + +ifndef VERSION +$(error VERSION is not set) +endif + +$(SNAP): $(SNAPINFO) $(FILES) + @if [ -f $(SNAP) ]; then \ + rm -v $(SNAP); \ + fi + + @ar cvr $(SNAP) $(SNAPINFO) $(MANIFEST); \ + if [ -f $(USHER) ]; then \ + chmod +x $(USHER); \ + ar cvr $(SNAP) $(USHER); \ + fi; \ + ar cvr $(SNAP) $(FILES) + + @echo "Successfully built $(SNAP)" + +$(SNAPINFO): $(MANIFEST) + @>$(SNAPINFO) + $(eval BYTES := $(shell du -sB1 $(ROOT)|awk '{print $$1}')) + + @printf "package: $(PACKAGE)\nversion: $(VERSION)\n" > $(SNAPINFO); \ + printf "depends: $(DEPENDS)\narch: $(ARCH)\nbytes: $(BYTES)\n" \ + >> $(SNAPINFO); \ + printf "url: $(URL)\ndescription: $(DESC)\n" >> $(SNAPINFO) + +$(MANIFEST): $(FILES) + @>$(MANIFEST) + + @bytes=0; \ + rootfiles=`cd $(ROOT) && find ! -path .|sed 's/^\.\///'|sort -r`; \ + while read -r file; do \ + info=`ls -ld "$(ROOT)/$$file"`; \ + perm=`echo $$info|awk '{print $$1}'`; \ + type=`echo $$perm|head -c1`; \ + sha='________________________________________'; \ + if [ $$type = 'c' ]; then \ + size=0; \ + fi; \ + if [ -f "$(ROOT)/$$file" ]; then \ + sha=`sha1sum "$(ROOT)/$$file"|awk '{print $$1}'`; \ + fi; \ + printf "$$sha\t$$perm\t$$file\n" >> $(MANIFEST); \ + done <<< "$$rootfiles" + +$(FILES): $(ROOT) +# Remove any perllocal.pod to avoid conflicts +# Should try to properly fix this some time... + + @find $(ROOT) -name perllocal.pod -exec rm {} \; + + @files=`find $(ROOT) -type f -exec file -i '{}' \;| grep \ + 'application/x-\(executable\|object\|sharedlib\);' | \ + grep ' charset=binary'`; \ + while read -r line; do \ + file=`echo $$line|sed 's/: application\/x-.*//'`; \ + if [ "$$file" != '' ]; then \ + strip --strip-unneeded $$file; \ + fi; \ + done <<< "$$files" + @cd $(ROOT) && tar cvzf $(FILES) * + diff --git a/SRC/snap-0.0/group b/SRC/snap-0.0/group new file mode 100644 index 0000000..9e65e34 --- /dev/null +++ b/SRC/snap-0.0/group @@ -0,0 +1,22 @@ +root:x:0: +bin:x:1:daemon +sys:x:2: +kmem:x:3: +tape:x:4: +tty:x:5: +daemon:x:6: +floppy:x:7: +disk:x:8: +lp:x:9: +dialout:x:10: +audio:x:11: +video:x:12: +utmp:x:13: +usb:x:14: +cdrom:x:15: +adm:x:16: +messagebus:x:18: +input:x:24: +mail:x:34: +nogroup:x:99: +users:x:999: diff --git a/SRC/snap-0.0/passwd b/SRC/snap-0.0/passwd new file mode 100644 index 0000000..757a665 --- /dev/null +++ b/SRC/snap-0.0/passwd @@ -0,0 +1,5 @@ +root:x:0:0:root:/root:/bin/bash +bin:x:1:1:bin:/dev/null:/bin/false +daemon:x:6:6:Daemon User:/dev/null:/bin/false +messagebus:x:18:18:D-Bus Message Daemon User:/var/run/dbus:/bin/false +nobody:x:99:99:Unprivileged User:/dev/null:/bin/false diff --git a/SRC/snap-0.0/snap b/SRC/snap-0.0/snap new file mode 100755 index 0000000..b90d9c5 --- /dev/null +++ b/SRC/snap-0.0/snap @@ -0,0 +1,2050 @@ +#!/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; + +############################################################ +# +# Set the process name +# +############################################################ + +$0 =~ s/.*\///; + +my $snapver; +my $conffile = '/etc/snap.conf'; +my $conf = readconf( $conffile ); + +open( FILE, "; +close( FILE ); +chomp( $snapver ); + +############################################################ +# +# This prevents buffering so output is immediately displayed +# +############################################################ + +$| = 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 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..."; + + 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 = ) { + ( 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 ) { + print " CONFLICTS FOUND\n"; + + return( \@conflicts ); + } + else { + print " none found\n"; + + return 0; + } + } + +### depends() ############################################## +# +# This is a recursive sub that drills down to the deepest +# dependencies and from there begins to push the values +# onto array ref $depends. This way the array will be +# ordered such that the package installations are performed +# in the correct order. +# +############################################################ + +sub depends { + my $packages = shift; + my $package = shift; + my $depends = shift; + + if ( -f $package ) { + $packages->{$package} = pkginfo( $package ); + } + + if ( $packages->{$package} && $packages->{$package}{'depends'} ) { + foreach my $depend ( split( ',', + $packages->{$package}{'depends'} ) ) { + depends( $packages, $depend, $depends ); + + if ( ! grep( /^$depend$/, @$depends ) ) { + push( @$depends, $depend ); + } + } + } + } + +sub httpget { + my $url = shift; + my $dest = shift; + my $mode = shift; + ( my $host = $url ) =~ s/^https?:\/\/|\/.*//g; + ( my $file = $url ) =~ s/.*$host//; + my $sock; + my %httpget = ( + 'status' => 0, + 'stdout' => '', + 'stderr' => '', + 'length' => 0, + 'type' => '', + 'dflag' => 0 + ); + my %result = ( + status => 0, + stdout => '', + stderr => '' + ); + + $sock = IO::Socket::INET->new( + PeerAddr => $host, + PeerPort => 'http(80)', + Proto => 'tcp' + ) || do{ + $result{'status'} = 1, + $result{'stderr'} = "$! - $@", + + return( \%result ); + }; + $sock->send("GET $file HTTP/1.0\r\n"); + $sock->send("Host: $host\r\n"); + $sock->send("\r\n"); + + open( DEST, ">$dest" ) || do { + $httpget{'status'} = 1; + $httpget{'stderr'} = "open: $dest: $!"; + + return( \%httpget ); + }; + chmod( $mode, $dest ) || do { + $httpget{'status'} = 1; + $httpget{'stderr'} = "chmod: $dest: $!"; + + return( \%httpget ); + }; + + 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; + + if ( $httpget{'status'} == 200 && ! fork() ) { + progress( $dest, $httpget{'length'} ); + + exit; + } + } + elsif ( ! $httpget{'type'} + && $_ =~ /Content-Type:\s+(\S+)/ ) { + $httpget{'type'} = $1; + } + elsif( $_ eq "\r\n" ) { + $httpget{'dflag'}++; + } + + next; + } + + print DEST $_; + } + + close( $sock ); + close( DEST ); + + return( \%httpget ); + } + +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 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 = ){ + 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 install { + my $pkgfile = shift; + my $target = shift || ''; + my $snapdir = "$target/$conf->{'general'}{'snapdir'}"; + my $info; + my $cmd; + my %runcmd; + 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 ) || do{ + $result{'status'} = 1; + $result{'stderr'} = 'install: mkdirp: failed to' + . " create directory $snapdir"; + + return( \%result ); + }; + } + + $info = pkginfo( $pkgfile ); + + if ( ! $info ) { + return( $info ); + } + + $package = $info->{'package'}; + $version = $info->{'version'}; + $snapinfo = "$snapdir/$package/snapinfo"; + $manifest = "$snapdir/$package/manifest"; + + 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 ); + } + + #################################################### + # + # 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" ) || do{ + $result{'status'} = 1; + $result{'stderr'} = "install: open: $!"; + + return( \%result ); + }; + open( TMPMANIFEST, ">$manifest.tmp" ) || do{ + $result{'status'} = 1; + $result{'stderr'} = "install: open: $!"; + + return( \%result ); + }; + + while ( my $line = ){ + print TMPMANIFEST $line; + } + + close( MANIFEST ); + close( TMPMANIFEST ); + } + + $cmd = "ar p $pkgfile snapinfo > $snapinfo"; + %runcmd = runcmd( $cmd ); + + while ( my @fhs = $runcmd{'sel'}->can_read ){ + foreach my $fh ( @fhs ){ + if ( fileno( $fh ) == fileno( $runcmd{'fh_out'} ) ){ + print STDOUT <$fh>; + } + 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 ); + } + + $cmd = "ar p $pkgfile manifest > $manifest"; + %runcmd = runcmd( $cmd ); + + while ( my @fhs = $runcmd{'sel'}->can_read ){ + foreach my $fh ( @fhs ){ + if ( fileno( $fh ) == fileno( $runcmd{'fh_out'} ) ){ + print STDOUT <$fh>; + } + 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 ); + } + + print "Extracting files for $info->{'package'}\e[?25l\n"; + + $cmd = "ar p $pkgfile files.tar.gz|tar -hzvxf - -C $target/"; + %runcmd = runcmd( $cmd ); + + while ( my @fhs = $runcmd{'sel'}->can_read ){ + 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"; + print STDOUT "\e[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 ); + } + + ############################################ + # + # 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" ){ + my $listdata = list( $package ); + + open( TMPMANIFEST, "<$manifest.tmp" ) || do{ + $result{'status'} = 1; + $result{'stderr'} = "install: open: $!"; + + return( \%result ); + }; + + while ( my $line = ){ + 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" ) || do{ + $result{'status'} = 1; + $result{'stderr'} = 'install:' + . " rmdir: $!"; + + return( \%result ); + }; + } + elsif ( -f "$target/$file" ){ + unlink( "$target/$file" ) || die( $! ); + } + } + } + + close( TMPMANIFEST ); + + unlink( "$manifest.tmp" ) || do{ + $result{'status'} = 1; + $result{'stderr'} = "install: unlink: $!"; + + return( \%result ); + }; + } + + if ( $mkinfo && ! $result{'status'} ){ + if ( mkinfo( $target ) ){ + $result{'status'} = 1; + $result{'stderr'} = 'Failed to update info db'; + } + } + + print STDOUT "\e[K$filenum files extracted\e[?25h\n\n"; + + usher( $pkgfile, $target, 'postinst' ); + + 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 = ) { + 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 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 = ){ + 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 manifest{ + 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 = ){ + 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 mkdirp{ + ( my $dir = shift ) =~ s/\/^//; + my $mode = shift; + ( my $parent = $dir ) =~ s/\/[^\/]+$//; + + if ( -d $dir ){ + return; + } + + mkdirp( $parent, $mode ); + + mkdir( $dir, $mode ) || return( $! ); + } + +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 ); + } + } + +### pkginfo() ############################################## +# +# This sub takes a package name or a snap package file as +# an argument along with the $target. The value for $target +# if present is prepended to the path when checking for +# a corresponding snapinfo file. +# +# If it is determined that the $package arg is not a file +# it will first check for the snapinfo file and return the +# info from there. If that file is also not present it will +# attempt to retrieve the info from the repository files. +# +# If no data is found in any of the three locations the +# sub will return null which the caller should interpret +# as meaning that no such package exists. +# +############################################################ + +sub pkginfo { + my $package = shift; + my $target = shift || ''; + my $pkgdir = "$target/$conf->{'general'}{'snapdir'}/$package"; + my $cmd = "ar p $package snapinfo"; + my %pkginfo; + my $regex = '^(' + . 'package' + . '|version' + . '|depends' + . '|arch' + . '|bytes' + . '|url' + . '|description' + . '):\s+(.*)'; + my %runcmd; + my $el; + + if ( ! -f $package ) { + my $packages = repo(); + + if ( $packages->{$package} ) { + $packages->{$package}{'package'} = $package; + + return( $packages->{$package} ); + } + + return; + } + + %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> ){ + chomp( $line ); + + if ( $line =~ /$regex/ ){ + $el = $1; + $pkginfo{$el} = $2; + } + elsif ( $el ){ + $pkginfo{$el} .= $line; + } + } + } + elsif ( fileno( $fh ) == fileno( $runcmd{'fh_err'} ) ){ + print STDERR <$fh>; + } + } + } + + close( $runcmd{'fh_out'} ); + close( $runcmd{'fh_err'} ); + + waitpid( $runcmd{'pid'}, 0 ); + + if ( $? >> 8 ) { + return; + } + + return( \%pkginfo ); + } + +sub progress { + my $file = shift; + my $total = shift; + my $bytes = 0; + my $pct = 0; + ( my $filename = $file ) =~ s/.*\///; + + print "\e[?25l"; + + while ( $bytes < $total ) { + $bytes = ( stat( $file ) )[7]; + + print "Retrieving $filename ["; + + for ( my $i = 0; $i < 20; $i++ ){ + if ( $i < $pct / 5 ) { + print '*'; + } + else { + print ' '; + } + } + + print "] $pct%\r"; + + if ( $bytes ) { + $pct = int( $bytes/$total*100 ); + } + + sleep( .5 ); + } + + print "Retrieving $filename [********************] 100%\e[?25h\n"; + + return; + } + +sub readconf { + my $file = shift; + my $section = ''; + my %data; + + open( FILE, "<$file" ) || die( "open: $file: $!\n" ); + + while ( ) { + chomp( $_ ); + + if ( $_ =~ /^\s*#/ ) { + next; + } + elsif ( $_ =~ /\[(\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 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 = ; + 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 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'} = + "$conf->{'sources'}{$source}" + . "$snapver/$1"; + } + elsif ( $buffer =~ /^sha256:\s+(.*)$/ ) { + $packages{$lastpkg}{'sha256'} = $1; + } + } + + $data->gzclose(); + } + + return( \%packages ); + } + +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 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 sha256 { + my $pkgfile = shift; + my $digest = eval { + Digest::SHA->new( 256 )->addfile( $pkgfile ); + } || do { + warn( "sha256: $pkgfile: $!\n" ); + return( '' ); + }; + + return( $digest->hexdigest ); + } + +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", 0755 ); + $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 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 ); + } + +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 ){ + 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, 0755 ); + } + + undef( $result{'stdout'} ); + undef( $result{'stderr'} ); + $cmd = "ar -p $pkgfile usher > $usher"; + %runcmd = runcmd( $cmd ); + + while ( my @fhs = $runcmd{'sel'}->can_read ){ + 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 ); + }; + + $cmd = "TARGET=$target $usher $stage"; + %runcmd = runcmd( $cmd ); + + while ( my @fhs = $runcmd{'sel'}->can_read ){ + 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 ); + } + +### 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 and Matt Johnson +# for recent releases; the original +# author is Kenneth J. Albanowski . +# 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 'install' || $ARGV[0] eq 'reinstall' ){ + my $packages; + my $installed; + my $info; + my $infodata; + my $result; + my $listdata; + my $manifest; + my $package; + my $pkgdir; + my $usher; + my $install; + my @depends; + my @depfails; + my $size = 0; + my $yes = 0; + my $target = ''; + + #################################################### + # + # This section obviously iterates the $yes variable + # if the user specifies -y, but it most importantly + # makes sure that either the last arg is assigned + # to $package or the last two args are assigned to + # $package and $target respectively. + # + # This will need to be adjusted at some time to + # allow installation of multiple packages. Perhaps + # have the $target assignment occur only when the + # value is a directory, and all previous args which + # are not -y or 'install' pushed onto a packages + # array + # + #################################################### + + for ( my $i = 0; $i <= $#ARGV; $i++ ){ + if ( $ARGV[$i] eq 'install' || $ARGV[$i] eq 'reinstall' ){ + next; + } + elsif ( $ARGV[$i] eq '-y' ){ + $yes++; + + next; + } + + if ( ! $package ){ + $package = $ARGV[$i]; + } + else{ + ( $target = $ARGV[$i] ) =~ s/\/$//; + } + } + + if ( ! -d "$target/$conf->{'general'}{'snapdir'}" ) { + mkdirp( "$target/$conf->{'general'}{'snapdir'}", 0755 ); + } + + $packages = repo(); + $installed = installed( $target ); + + #################################################### + # + # pkginfo() should return package information for + # any package that is valid, whether it's installed, + # a valid package file, or in the repos + # + # If no data is returned the package is considered + # to be invalid + # + #################################################### + + $info = pkginfo( $package ); + + if ( ! $info ) { + print STDERR "snap: $package: invalid snap package\n"; + + exit 1; + } + + if ( $installed->{$info->{'package'}} && $info->{'version'} eq + $installed->{$info->{'package'}}{'version'} && + $ARGV[0] ne 'reinstall' ) { + print STDERR "$info->{'package'} $info->{'version'}" + . " is already installed\n"; + + exit 1; + } + + $pkgdir = "$target/$conf->{'general'}{'snapdir'}/$info->{'package'}"; + $size += $info->{'bytes'}; + + depends( $packages, $package, \@depends ); + + #################################################### + # + # This section iterates through all dependencies, + # removes from @depends those already installed, + # adds uninstallable packages to @depfails, then + # adds the package bytes value to $size + # + #################################################### + + for ( my $i = $#depends; $i >= 0; $i-- ) { + if ( $installed->{$depends[$i]} ) { + splice( @depends, $i, 1 ); + + next; + } + + if ( ! $packages->{$depends[$i]} ) { + push( @depfails, $depends[$i] ); + + next; + } + + $size += $packages->{$depends[$i]}{'bytes'}; + } + + if ( @depfails ) { + print STDERR "The following dependencies are not" + . " installable:\n"; + + foreach my $depfail ( sort( @depfails ) ) { + print STDERR " $depfail\n"; + } + + exit 1; + } + + if ( $installed->{$info->{'package'}} ) { + my $instver = $installed->{$info->{'package'}}{'version'}; + my $newver = $info->{'version'}; + my $process; + + if ( vercmp( $instver, $newver ) < 0 ) { + print "Upgrading $info->{'package'}" + . " ($instver --> $newver)\n"; + } + elsif ( vercmp( $instver, $newver ) > 0 ) { + print "Downgrading $info->{'package'}" + . " ($instver --> $newver)\n"; + } + else { + print "Reinstalling $info->{'package'} ($instver)\n"; + } + } + elsif ( $ARGV[1] eq 'reinstall' ) { + print "$info->{'package'} cannot be re-installed" + . " since it is not currently installed\n"; + + exit 1; + } + else { + print "Installing $info->{'package'} $info->{'version'}\n"; + } + + 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 ( ! $yes ){ + print "Continue"; + + if ( $target ) { + print " on $target"; + } + + print "? (y/n): "; + } + + while( ! $yes ){ + $yes = ; + 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 ); + } + } + + foreach my $depend ( @depends ) { + my $depdir = "$target/$conf->{'general'}{'snapdir'}/$depend"; + my $dlpath = $packages->{$depend}{'path'}; + ( my $file = $dlpath ) =~ s/.*\///; + my $hash; + + if ( ! -d $depdir ) { + mkdir( $depdir, 0755 ) || do { + print STDERR "snap: $!\n"; + + exit 1; + } + } + + if ( ! -f "$depdir/$file" ) { + my $httpget = httpget( $dlpath, "$depdir/$file", 0644 ); + + if ( $httpget->{'status'} != 200 ) { + print STDERR "httpget: $file: failed with" + . " $httpget->{'status'}\n"; + + exit 1; + } + } + + $hash = sha256( "$depdir/$file" ); + + if ( $hash ne $packages->{$depend}{'sha256'} ) { + print STDERR "Incorrect hash for $file\n"; + + exit 1; + } + } + + if ( ! -d $pkgdir ) { + mkdir( $pkgdir, 0755 ) || do { + print STDERR "snap: mkdir: $!\n"; + + exit 1; + } + } + if ( ! -f $package ) { + my $dlpath = $info->{'path'}; + ( my $file = $dlpath ) =~ s/.*\///; + my $hash; + + if ( ! -f "$pkgdir/$file" ) { + my $httpget = httpget( $dlpath, "$pkgdir/$file", 0755 ); + + if ( $httpget->{'status'} != 200 ) { + print STDERR "httpget: $file: failed with" + . " $httpget->{'status'}\n"; + + exit 1; + } + } + + $hash = sha256( "$pkgdir/$file" ); + + if ( $hash ne $packages->{$package}{'sha256'} ) { + print STDERR "Incorrect hash for $file\n"; + + exit 1; + } + + $package = "$pkgdir/$file"; + } + + #################################################### + # + # This executes the usher script in the package + # file if present with the arg 'preinst'. The usher + # script should perform any actions which might be + # necessary prior to installing dependencies. + # + #################################################### + + $usher = usher( $package, $target, 'preinst' ); + + if ( $usher->{'status'} ) { + print STDERR "Failed to execute usher for $package\n" + . "$usher->{'stderr'}\n"; + + exit 1; + } + + foreach my $depend ( @depends ) { + my $depdir = "$target/$conf->{'general'}{'snapdir'}/$depend"; + my $dlpath = $packages->{$depend}{'path'}; + ( my $file = $dlpath ) =~ s/.*\///; + + ############################################ + # + # This runs usher for each dependency in + # order, and since @depends starts at the + # lowest level dependency we are certain + # to execute the preinst at the appropriate + # time. + # + ############################################ + + $usher = usher( "$depdir/$file", $target, 'preinst' ); + + if ( $usher->{'status'} ) { + print STDERR "Failed to execute usher for $depend\n" + . "$usher->{'stderr'}\n"; + + exit 1; + } + + print "Preparing to install $depend" + . " $packages->{$depend}{'version'}\n"; + + $install = install( "$depdir/$file", $target ); + + if ( $install->{'status'} ) { + print STDERR "$install->{'stderr'}\n"; + + exit 1; + } + } + + print "Preparing to install $info->{'package'} $info->{'version'}\n"; + $install = install( $package, $target ); + + if ( $install->{'status'} ) { + print STDERR "$install->{'stderr'}\n"; + + exit 1; + } + + print "$info->{'package'} $info->{'version'} successfully installed\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 'list' ){ + 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 '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; + + $packages = httpget( "$src/$snapver/packages.gz", + $dest, $mode ); + + if ( $packages->{'status'} != 200 ) { + 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( $ARGV[1] || '' ); + + 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( lc( $packages->{$package}{'description'} ), + lc( $ARGV[1] ) ) != -1) { + print "$package - " + . "$packages->{$package}{'description'}\n"; + } + } + } +else{ + print STDERR "snap Error: $ARGV[0] is not a valid argument\n"; + + exit 1; + } + diff --git a/SRC/snap-0.0/snap.conf b/SRC/snap-0.0/snap.conf new file mode 100644 index 0000000..76e5204 --- /dev/null +++ b/SRC/snap-0.0/snap.conf @@ -0,0 +1,6 @@ +[general] +snapdir = var/snap +pkgfile = packages.gz + +[sources] +default = http://packages.snaplinux.org/ diff --git a/SRC/snap-0.0/snap.inprogress b/SRC/snap-0.0/snap.inprogress new file mode 100644 index 0000000..852b4da --- /dev/null +++ b/SRC/snap-0.0/snap.inprogress @@ -0,0 +1,2060 @@ +#!/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, "; +close( FILE ); +chomp( $snapver ); + +sub readconf { + my $file = shift; + my $section = ''; + my %data; + + open( FILE, "<$file" ) || die( "open: $file: $!\n" ); + + while ( ) { + 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 = ){ + 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 = ){ + 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 = ){ + 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( ); + + 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 = ){ + ( 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 = ){ + 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 = ; + 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 = ){ + 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 = ){ + 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 = ; + 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 = ){ + 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 = ; + 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 and Matt Johnson +# for recent releases; the original +# author is Kenneth J. Albanowski . +# 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 = ; + 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 = ){ + 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 = ){ + 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; + } + diff --git a/SRC/snap-0.0/snap_version b/SRC/snap-0.0/snap_version new file mode 100644 index 0000000..68efb73 --- /dev/null +++ b/SRC/snap-0.0/snap_version @@ -0,0 +1 @@ +0.0alpha0