diff --git a/Makefile b/Makefile index 0ca67f5..5127db4 100644 --- a/Makefile +++ b/Makefile @@ -8,15 +8,15 @@ # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. -DEPENDS = bash,binutils,coreutils,gzip,iana-etc,iproute2,inetutils,initscripts,perl,shadow,sysvinit,tar +DEPENDS = binutils,coreutils,gzip,perl=5.20.0,tar ARCH = x86_64 URL = -DESC = This is the base of the snaplinux system +DESC = The Snaplinux package management system ARCHIVE := '' SRCDIR := $(PWD)/SRC/snap PATCHDIR := $(PWD)/SRC/patches -VERSION := 0.2sr1 +VERSION := 0.4-0 MAKEINST = make install @@ -29,8 +29,7 @@ $(ROOT): $(SRCDIR)/Makefile mkdir -v $(ROOT); \ fi - @cd $(SRCDIR); \ - $(MAKEINST) DESTDIR=$(ROOT) + @cd $(SRCDIR) && $(MAKEINST) DESTDIR=$(ROOT) clean: @rm -rvf $(ROOT) \ diff --git a/SNAP/usher b/SNAP/usher index 0472cf3..b402e27 100755 --- a/SNAP/usher +++ b/SNAP/usher @@ -2,94 +2,9 @@ set -e -PASSWD="root:SETPASS: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 + exit 0 ;; postinst) setpass=`cat ${TARGET}/etc/shadow|grep ^root|awk -F':' '{print $2}'` diff --git a/SRC/snap/Commands.pm b/SRC/snap/Commands.pm new file mode 100644 index 0000000..c13692f --- /dev/null +++ b/SRC/snap/Commands.pm @@ -0,0 +1,258 @@ +package Snap::Commands; + +use strict; +use warnings; + +use parent 'Snap'; + +my $commands = { + files => { + options => [ + '', + '[-t TARGET]', + '[-v]' + ], + brief => 'List files in package', + help => [ + "\t\tPKGNAME or FILE is required. If PKGNAME\n" + . "\t\t\t\tis used it must be an installed package\n", + "\t\t\tAn optional target may be specified" + . " to\n\t\t\t\tquery a separate" + . " directory/file system\n", + "\t\t\t\tShow full manifest details" + ] + }, + genpkg => { + options => [ + '' + ], + brief => 'Create package build directory', + help => [ + "\t\t\tPKGNAME is required. This will" + . " create a\n\t\t\t\tdirectory of the same" + . " name and populate\n\t\t\t\tit with a" + . " skeleton of files and" + . " directories\n\t\t\t\trequired to build" + . " a snap package" + ] + }, + help => { + options => [], + brief => 'Print brief usage information', + help => [] + }, + info => { + options => [ + '', + '[-t TARGET]' + ], + brief => 'List package info', + help => [ + "\t\tPKGNAME or FILE is required." + . " A version string\n\t\t\t\tcan optionally" + . " be provided with the PKGNAME\n" + . "\t\t\t\tas packagename=x.x.x\n", + "\t\t\tAn optional target may be specified" + . " to\n\t\t\t\tquery a separate directory" + . "/file system" + ] + }, + install => { + options => [ + '', + '[-t TARGET]', + '[--no-deps]', + '[-y]' + ], + brief => 'Install package', + help => [ + "\t\tPKGNAME or FILE is required" + . " A version string\n\t\t\t\tcan optionally" + . " be provided with the PKGNAME\n" + . "\t\t\t\tas packagename=x.x.x\n", + "\t\t\tAn optional target may be specified" + . " to\n\t\t\t\tinstall the package to a" + . " separate\n\t\t\t\tdirectory/file system\n", + "\t\t\tInstall the package without dependencies\n", + "\t\t\t\tProceed without prompting" + ] + }, + list => { + options => [ + '[-a]', + '[-r REPO]', + '[-t TARGET]' + ], + brief => 'List packages', + help => [ + "\t\t\t\tList all repo and installed packages\n", + "\t\t\tOptionally specify a repository to list\n", + "\t\t\tAn optional target may be specified" + . " to\n\t\t\t\tquery a separate directory" + . "/file system" + ] + }, + purge => { + options => [ + '', + '[-t TARGET]', + '[-y]' + ], + brief => 'Remove package and/or configs', + help => [ + "\t\t\tPKGNAME is required\n", + "\t\t\tAn optional target may be specified" + . " to\n\t\t\t\tinstall the package to a" + . " separate\n\t\t\t\tdirectory/file system\n", + "\t\t\t\tProceed without prompting" + ] + }, + rebuild => { + options => [ + '[-t TARGET]', + '[-y]' + ], + brief => 'Rebuild package DB', + help => [ + "\t\t\tAn optional target may be specified" + . " to\n\t\t\t\trepair the DB of a" + . " separate\n\t\t\t\tdirectory/file system\n", + "\t\t\t\tProceed without prompting" + ] + }, + reinstall => { + options => [ + '', + '[-t TARGET]', + '[-y]' + ], + brief => 'Re-install package', + help => [ + "\t\t\tPKGNAME is required\n", + "\t\t\tAn optional target may be specified" + . " to\n\t\t\t\tre-install the package on a" + . " separate\n\t\t\t\tdirectory/file system\n", + "\t\t\t\tProceed without prompting" + ] + }, + remove => { + options => [ + '', + '[-t TARGET]', + '[-y]' + ], + brief => 'Remove a package', + help => [ + "\t\t\tPKGNAME is required\n", + "\t\t\tAn optional target may be specified" + . " to\n\t\t\t\tremove the package from a" + . " separate\n\t\t\t\tdirectory/file system\n", + "\t\t\t\tProceed without prompting" + ] + }, + search => { + options => [ + '[STRING[=VER]]', + '[-a]', + '[-v]' + ], + brief => 'Search repositories for packages', + help => [ + "\t\tSTRING is optional. If STRING is not\n" + . "\t\t\t\tprovided all repo packages are listed.\n" + . "\t\t\t\tAn optional version string may be used\n", + "\t\t\t\tReturn all versions from all repos\n", + "\t\t\t\tPrint verbose output" + ] + }, + source => { + options => [ + '' + ], + brief => 'Retrieve package source', + help => [ + "\t\tPKGNAME is required." + . " A version string\n\t\t\t\tcan optionally" + . " be provided with the PKGNAME\n" + . "\t\t\t\tas packagename=x.x.x" + ] + }, + upgrade => { + options => [ + '[PKGNAME]', + '[-t TARGET]', + '[-y]' + ], + brief => 'Upgrade packages', + help => [ + "\t\t\tWith no arguments all packages are upgraded\n" + . "\t\t\t\totherwise only the specified package\n", + "\t\t\tAn optional target may be specified" + . " to\n\t\t\t\tupgrade the package on a" + . " separate\n\t\t\t\tdirectory/file system\n", + "\t\t\t\tProceed without prompting" + ] + }, + verify => { + options => [ + '[PKGNAME]', + '[-t TARGET]', + '[-y]' + ], + brief => 'Verify integrity of packages', + help => [ + "\t\t\tWith no arguments all packages are verified\n" + . "\t\t\t\totherwise only the specified package\n", + "\t\t\tAn optional target may be specified" + . " to\n\t\t\t\tverify the package on a" + . " separate\n\t\t\t\tdirectory/file system\n", + "\t\t\t\tProceed without prompting" + ] + } + }; + +sub commandhelp { + my $self = shift; + my $command = shift; + + if ( ! $self->{$command} ) { + Snap->error( 64, "help(): Invalid command '$command'" ); + } + + my $options = $commands->{$command}{'options'}; + my $help = $commands->{$command}{'help'}; + + print "\nsnap $command @{$commands->{$command}{'options'}}\n\n"; + print "$commands->{$command}{'brief'}\n\n"; + + for ( my $i = 0; $i <= $#{$options}; $i++ ) { + print " $options->[$i]$help->[$i]\n"; + } + + print "\n"; + } + +sub new { + my $class = shift; + + return( bless( $commands, $class ) ); + } + +sub help { + if ( @ARGV ) { + Snap->error( -1, "usage(): Invalid option '$ARGV[0]'" ); + } + + print "\nUsage: $0 \n\n" + . "snap is the Snaplinux package management utility\n\n" + . "COMMANDS\n\n"; + + foreach my $command ( sort( keys( %$commands ) ) ) { + print " $command \t\t\t$commands->{$command}{'brief'}\n" + } + + print "\nTo view more information for commands run:\n" + . "snap -h\n\n"; + } + +1; diff --git a/SRC/snap/Makefile b/SRC/snap/Makefile index 19c7824..4c74d5b 100644 --- a/SRC/snap/Makefile +++ b/SRC/snap/Makefile @@ -1,12 +1,21 @@ dirs: install -d -v -m 755 $(DESTDIR)/etc install -d -v -m 755 $(DESTDIR)/usr/{bin,share/snap} + install -d -v -m 755 $(DESTDIR)/usr/lib/perl5/vendor_perl/5.24.0/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.skel \ + $(DESTDIR)/usr/share/snap/Makefile.skel install -v -m 644 Makefile.snaplinux \ $(DESTDIR)/usr/share/snap/Makefile.snaplinux + install -v -m 644 Commands.pm \ + $(DESTDIR)/usr/lib/perl5/vendor_perl/5.24.0/Snap/Commands.pm + install -v -m 644 Package.pm \ + $(DESTDIR)/usr/lib/perl5/vendor_perl/5.24.0/Snap/Package.pm + install -v -m 644 Sources.pm \ + $(DESTDIR)/usr/lib/perl5/vendor_perl/5.24.0/Snap/Sources.pm + install -v -m 644 Snap.pm \ + $(DESTDIR)/usr/lib/perl5/vendor_perl/5.24.0/Snap.pm install: dirs files diff --git a/SRC/snap/Makefile.skel b/SRC/snap/Makefile.skel new file mode 100644 index 0000000..b77a08e --- /dev/null +++ b/SRC/snap/Makefile.skel @@ -0,0 +1,75 @@ +# 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 = +ARCH = +URL = +BRIEF = +DESC = +SNAPVER = + +ARCHIVE := $(PWD)/SRC/$(shell ls SRC|egrep '(bz2|gz|tar|xz)$$'|tail -1) +TYPE := $(shell file -ib $(ARCHIVE)|cut -d';' -f1|tr -d '\n') +SRCDIR := $(shell tar -tf $(ARCHIVE)|head -1|sed 's/\/.*//') +PATCHDIR := $(PWD)/SRC/patches +VERSION := $(shell echo $(SRCDIR)|egrep -o '\-[0-9].*'|sed 's/^-//')$(SNAPVER) + +include /usr/share/snap/Makefile.snaplinux + +$(SRCDIR)/configure: $(ARCHIVE) + @if [ '$(TYPE)' == 'application/x-bzip2' ]; then \ + tar -jxf $(ARCHIVE); \ + elif [ '$(TYPE)' == 'application/x-gzip' ]; then \ + tar -zxf $(ARCHIVE); \ + elif [ '$(TYPE)' == 'application/x-tar' ]; then \ + tar -xf $(ARCHIVE); \ + elif [ '$(TYPE)' == 'application/x-xz' ]; then \ + tar -xf $(ARCHIVE); \ + else \ + echo 'Unable to determine archive type'; \ + exit 1; \ + fi + @touch $(SRCDIR)/configure + +$(SRCDIR)/config.log: $(SRCDIR)/configure + @cd $(SRCDIR) && \ + for patch in `find $(PATCHDIR) -name \*.patch|sort`; do \ + patch --verbose -Np1 -i $$patch; \ + done + @cd $(SRCDIR); \ + ./configure \ + --prefix=/usr \ + --build=x86_64-snap-linux-gnu \ + --host=x86_64-snap-linux-gnu \ + --target=x86_64-snap-linux-gnu + +$(SRCDIR)/binfile: $(SRCDIR)/config.log + @cd $(SRCDIR) && make + +$(ROOT): $(SRCDIR)/binfile + @if [ -d $(ROOT) ]; then \ + touch $(ROOT); \ + else \ + mkdir -v $(ROOT); \ + fi + + @cd $(SRCDIR) && make install DESTDIR=$(ROOT) + +test: $(ROOT) + @cd $(SRCDIR); \ + make check + +clean: + @rm -rvf $(ROOT) \ + $(SNAPINFO) \ + $(MANIFEST) \ + $(FILES) \ + $(SRCDIR) + diff --git a/SRC/snap/Makefile.snaplinux b/SRC/snap/Makefile.snaplinux index 74e06fa..8e0560d 100644 --- a/SRC/snap/Makefile.snaplinux +++ b/SRC/snap/Makefile.snaplinux @@ -19,6 +19,15 @@ MANIFEST = $(SNAPDIR)/manifest USHER = $(SNAPDIR)/usher FILES = $(SNAPDIR)/files.tar.gz +# If multiple packages are pulled from a single source +# then that source needs to be specified in SRCPKG, but +# if we find that not to be supplied we're going to +# assume that the SRCPKG is the same as the PACKAGE + +ifeq ( $(SRCPKG), ) +SRCPKG := $(PACKAGE) +endif + # The following values must be set in the Makefile for the package ifndef VERSION @@ -42,16 +51,18 @@ $(SNAP): $(SNAPINFO) $(FILES) $(SNAPINFO): $(MANIFEST) @>$(SNAPINFO) $(eval BYTES := $(shell gzip -l $(FILES)|tail -1|awk '{print $$2}')) + $(eval SHA256MAN := $(shell sha256sum $(MANIFEST)|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) + @printf "name: $(PACKAGE)\nversion: $(VERSION)\n" > $(SNAPINFO) && \ + printf "depends: $(DEPENDS)\narch: $(ARCH)\n" >> $(SNAPINFO) && \ + printf "srcpkg: $(SRCPKG)\nbytes: $(BYTES)\n" >> $(SNAPINFO) && \ + printf "url: $(URL)\nsha256man: $(SHA256MAN)\n" >> $(SNAPINFO) && \ + printf "brief: $(BRIEF)\ndescription: $(DESC)" >> $(SNAPINFO) $(MANIFEST): $(FILES) @>$(MANIFEST) - rootfiles=`cd $(ROOT) && find ! -path .|sed 's/^\.\///'|sort -r`; \ + @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}'`; \ @@ -69,22 +80,46 @@ $(MANIFEST): $(FILES) $(FILES): $(ROOT) # Remove any perllocal.pod to avoid conflicts # Should try to properly fix this some time... - @find $(ROOT) -name perllocal.pod -exec rm {} \; - @find $(ROOT) -type f | while read -r file; do \ - type=`file -i $$file|sed 's/.*: //'`; \ - case $$type in \ - *'/x-executable; charset=binary') \ - strip --strip-unneeded $$file \ - ;; \ - *'/x-object; charset=binary') \ - strip --strip-debug $$file \ - ;; \ - *'/x-sharedlib; charset=binary') \ - strip --strip-debug $$file \ - ;; \ - esac; \ - done + @if [ -d $(ROOT)/usr/share/man ]; then \ + find $(ROOT)/usr/share/man -type f -not -name \*.gz| \ + while read -r file; do \ + gzip $$file; \ + done; \ + find $(ROOT)/usr/share/man -type l| \ + while read -r file; do \ + target=`readlink $$file`; \ + path=`dirname $$file`; \ + full="$$path/$$target"; \ + if [ ! -f $$full ] && [ -f $$full.gz ]; then \ + ln -sf $$target.gz $$file; \ + fi; \ + done; \ + fi + + @if [ -d $(ROOT)/usr/share/info ]; then \ + find $(ROOT)/usr/share/info -type f -name \*.info| \ + while read -r file; do \ + gzip $$file; \ + done; \ + fi + + if [ "$(PACKAGE)" != 'grub' ]; then + @find $(ROOT) -type f | while read -r file; do \ + type=`file -i $$file|sed 's/.*: //'`; \ + case $$type in \ + *'/x-executable; charset=binary') \ + strip --strip-unneeded $$file \ + ;; \ + *'/x-object; charset=binary') \ + strip --strip-unneeded $$file \ + ;; \ + *'/x-sharedlib; charset=binary') \ + strip --strip-unneeded $$file \ + ;; \ + esac; \ + done; \ + fi @cd $(ROOT) && tar cvzf $(FILES) * diff --git a/SRC/snap/Package.pm b/SRC/snap/Package.pm new file mode 100644 index 0000000..d6fc60c --- /dev/null +++ b/SRC/snap/Package.pm @@ -0,0 +1,840 @@ +package Snap::Package; + +use strict; +use warnings; + +use Fcntl; +use IPC::Open3; +use IO::Select; +use Cwd 'abs_path'; +use Data::Dumper; + +use parent 'Snap'; + +### new() ################################################## +# +# This creates a new package object. The attributes are: +# +# * arch: The architecture for which the package is built +# * brief: short desription of package +# * bytes: total bytes of installed package +# * depends: comma separated list of package dependencies +# * description: long description of package +# * name: package name +# * path: path to package, either local or repo file +# * source: source server +# * repo: repository where package is located, empty for +# local file +# * sha256: sha256sum for package file +# * sha256man: sha256sum for package manifest file +# * status: The current status of the package, one of: +# installed +# installing +# removing +# uninstalled +# upgrading +# * url: upstream source url +# * version: version string +# +############################################################ + +sub new { + my $class = shift; + my $package = shift; + my $infofile = Snap->INSTDIR . "/$package/snapinfo"; + my $self = { + arch => '', + brief => '', + bytes => 0, + depends => '', + srcpkg => '', + description => '', + name => '', + source => '', + path => '', + repo => '', + sha256 => '', + sha256man => '', + status => '', + url => '', + version => '' + }; + + if ( ref( $package ) ) { + foreach my $attr ( keys( %$self ) ) { + $self->{$attr} = $package->{$attr}; + } + } + elsif ( -f $package ) { + my $sel = IO::Select->new(); + my $stdout; + my $stderr; + my $stat; + my $pid; + + eval { + $pid = open3( \*CHLDIN, \*CHLDOUT, \*CHLDERR, + "/usr/bin/ar p $package snapinfo" ); + } || Snap->error( int( $! ), "open3(): /usr/bin/ar:" + . " $!" ); + + close( CHLDIN ); + + $sel->add( *CHLDOUT, *CHLDERR ); + + while ( my @fhs = $sel->can_read ) { + foreach my $fh ( @fhs ) { + if ( eof( $fh ) ) { + $sel->remove( $fh ); + + next; + } + + if ( fileno( $fh ) == fileno( *CHLDOUT ) ) { + $stdout .= <$fh>; + } + elsif ( fileno( $fh ) == fileno( *CHLDERR ) ) { + $stderr .= <$fh>; + } + } + } + + close( CHLDOUT ); + close( CHLDERR ); + + waitpid( $pid, 0 ); + $stat = $? >> 8; + + if ( $stat ) { + $stderr =~ s/.*: //; + + Snap->error( $stat, "Failed reading '$package':" + . " $stderr" ); + } + + foreach ( split( /\n/, $stdout ) ) { + if ( $_ =~ /^(\S+):\s*(.*)$/ ) { + $self->{$1} = $2; + } + } + + $self->{'source'} = 'localhost'; + $self->{'path'} = abs_path( $package ); + } + elsif ( -f $infofile ) { + open( SNAPINFO, "<$infofile" ) || + Snap->error( int( $! ), "open(): $infofile: $!" ); + + while( ) { + #################################### + # + # Temporary fix!!! Will need to + # remove after all packages are + # corrected... + # + #################################### + + $_ =~ s/^package:/name:/; + + if ( $_ = /^(\S+):\s+(.*)$/ ) { + $self->{$1} = $2; + } + } + + close( SNAPINFO ) || + Snap->error( int( $! ), "close(): $infofile: $!" ); + + $self->{'status'} = 'installed'; + } + else { + Snap->error( -2, "'$package': No such file or package found" ); + } + + return( bless( $self, $class ) ); + } + +sub conflicts { + my $self = shift; + my $sources = shift; + my $conflicts = {}; + + $self->files( { quiet => 1 } ); + + foreach my $pkgname ( keys( %{$sources->{'installed'}} ) ) { + if ( $pkgname eq $self->{'name'} ) { + next; + } + + my $installed = $sources->{'installed'}{$pkgname}; + + foreach my $file ( @{$installed->{'files'}} ) { + if ( grep( $_ eq $file, @{$self->{'files'}} ) ) { + if ( ! $conflicts->{$installed->{'name'}} ) { + $conflicts->{$installed->{'name'}} = []; + } + + push( @{$conflicts->{$installed->{'name'}}}, + $file ); + } + } + } + + if ( keys( %$conflicts ) ) { + print STDERR "\nPackage $self->{'name'} conflicts with the" + . " following packages:\n\n"; + + foreach my $pkgname ( sort { $conflicts->{$a}{'name'} cmp + $conflicts->{$b}{'name'} } keys( %$conflicts ) ) { + print STDERR "[$pkgname]\n"; + + foreach my $file ( sort { $a cmp $b } + @{$conflicts->{$pkgname}} ) { + print " * $file\n"; + } + + print "\n"; + } + + Snap->error( -1, "Exiting due to conflicts" ); + } + } + +sub depends { + my $self = shift; + my $sources = shift; + my $dependencies = shift; + my $failures = shift; + my $selflist = shift; + + if ( ! $failures ) { + $failures = []; + } + + if ( ! $selflist ) { + $selflist = {}; + } + + if ( ! $selflist->{$self->{'name'}} ) { + $selflist->{$self->{'name'}} = $self; + } + else { + Snap->error( -1, "$self->{'name'}=$self->{'version'}:" + . " Package $selflist->{$self->{'name'}}=" + . "$selflist->{$self->{'name'}}{'version'}" + . " already slated for installation" ); + } + + if ( $self->{'depends'} ) { + foreach my $depend ( split( ',', $self->{'depends'} ) ) { + my ( $name, $req ) = split( /(((<|>)=?|=)(.*))/, + $depend ); + my $package; + + if ( $self->{'name'} eq $name ) { + Snap->error( -1, "$self->{'name'}" + . "=$self->{'version'}:" + . " A package cannot be" + . " dependant on itself" ); + } + + if ( $selflist->{$name} && ( ! $req || + Snap->chkreq( $req, + $selflist->{$name}{'version'} ) ) ) { + next; + } + elsif ( $sources->{'installed'}{$name} && ( ! $req || + Snap->chkreq( $req, + $sources->{'installed'}{$name}{'version'} ) ) ) { + next; + } + + $package = $sources->search( { + quiet => 1, + name => $name, + version => $req + } ); + + if ( ! $package ) { + push( @$failures, $depend ); + + next; + } + + if ( ( grep { $_->{'name'} eq $package->{'name'} } + @$dependencies ) || $package->installed() ) { + next; + } + + $package->depends( $sources, $dependencies, + $failures, $selflist ); + + push( @$dependencies, $package ); + } + } + + if ( @$failures ) { + print STDERR "Failed to resolve dependencies for" + . " $self->{'name'}!\n"; + + Snap->error( -1, "depends(): dependencies failed: " + . join( ",", @$failures ) ); + } + + $self->revdeps( $sources, $dependencies ); + } + +sub files { + my $self = shift; + my $opts = shift; + my $manifestfile = Snap->INSTDIR . "/$self->{'name'}/manifest"; + $self->{'files'} = []; + + if ( $self->{'path'} && -f $self->{'path'} ) { + my $sel = IO::Select->new(); + my $stdout; + my $stderr; + my $stat; + my $pid = open3( \*CHLDIN, \*CHLDOUT, \*CHLDERR, + "/usr/bin/ar p $self->{'path'} manifest" ); + + close( CHLDIN ); + + $sel->add( *CHLDOUT, *CHLDERR ); + + while ( my @fhs = $sel->can_read ) { + foreach my $fh ( @fhs ) { + if ( eof( $fh ) ) { + $sel->remove( $fh ); + + next; + } + + if ( fileno( $fh ) == fileno( *CHLDOUT ) ) { + my ( $sha, $perms, $file ) = + split( /\s+/, <$fh> ); + + if ( ! $opts->{'all'} && + $perms =~ /^d/ ) { + next; + } + + if ( $opts->{'quiet'} ) { + push( @{$self->{'files'}}, + $file ); + } + elsif ( $opts->{'verbose'} ) { + print "$sha\t$perms\t$file\n"; + } + else { + print "$file\n"; + } + } + elsif ( fileno( $fh ) == fileno( *CHLDERR ) ) { + $stderr .= <$fh>; + } + } + } + + close( CHLDOUT ); + close( CHLDERR ); + + waitpid( $pid, 0 ); + $stat = $? >> 8; + + if ( $stat || $stderr ) { + $stderr =~ s/.*: //; + + if ( ! $stat ) { + $stat = -1; + } + + Snap->error( $stat, "Failed reading '$self->{'path'}':" + . " $stderr" ); + } + } + elsif ( -f $manifestfile ) { + open( MANIFEST, "<$manifestfile" ) || + Snap->error( int( $! ), "open(): $manifestfile: $!" ); + + while ( ) { + my ( $sha, $perms, $file ) = split( /\s+/, $_ ); + + if ( ! $opts->{'all'} && $perms =~ /^d/ ) { + next; + } + + if ( $opts->{'quiet'} ) { + if ( ! $self->{'files'} ) { + $self->{'files'} = []; + } + + push( @{$self->{'files'}}, $file ); + } + elsif ( $opts->{'verbose'} ) { + print "$sha\t$perms\t$file\n"; + } + else { + print "$file\n"; + } + } + + close( MANIFEST ) || + Snap->error( int( $! ), "open(): $manifestfile: $!" ); + } + else { + Snap->error( -2, "'$self->{'name'}':" + . " No such file or package installed" ); + } + } + +sub install { + my $self = shift; + my $sources = shift; + my $pkgdir = Snap->INSTDIR . "/$self->{'name'}"; + my $snapinfo = "$pkgdir/snapinfo"; + my $manifest = "$pkgdir/manifest"; + my $oldpkg; + my $pid; + my $sel; + my $cnt; + my $libcnt; + my $stderr; + my $stat; + local $| = 1; + + print "\e[?25lInstalling $self->{'name'}:\r"; + + if ( $self->{'path'} =~ /^https*:\/\// ) { + ( my $filename = $self->{'path'} ) =~ s/.*\///; + + Snap->httpget( $self->{'path'}, Snap->PKGDIR + . "/$filename", 0644 ); + + $self->{'path'} = Snap->PKGDIR . "/$filename"; + } + + if ( ! -d $pkgdir ) { + mkdir( $pkgdir, 0644 ) || + Snap->error( int( $! ), "mkdir(): $pkgdir: $!" ); + } + + #################################################### + # + # If a different version of this package is + # installed we need to capture the file list from + # the old manifest file so that any files which are + # no longer a part of the package are cleaned up + # after installing the new version. + # + # We also move the old snapinfo and manifest to + # temporary files which are cleaned up after the + # new package is successfully installed. Holding + # on to these things until after we're sure the + # install was successful is not a bad idea... + # + #################################################### + + if ( $sources->{'installed'}{$self->{'name'}} ) { + $oldpkg = $sources->{'installed'}{$self->{'name'}}; + + rename( $snapinfo, "$snapinfo.$oldpkg->{'version'}" ) || + Snap->error( int( $! ), "rename(): $snapinfo: $!" ); + rename( $manifest, "$manifest.$oldpkg->{'version'}" ) || + Snap->error( int( $! ), "rename(): $manifest: $!" ); + } + + $self->usher( 'preinst' ); + + eval { + $pid = open3( \*CHLDIN, \*CHLDOUT, \*CHLDERR, + "/usr/bin/ar p $self->{'path'} files.tar.gz|" + . "tar --no-overwrite-dir -hzvxf - -C " + . Snap->TARGET ); + } || Snap->error( int( $! ), "open3(): /usr/bin/ar: $!" ); + + close( CHLDIN ); + + $sel = IO::Select->new(); + $sel->add( *CHLDOUT, *CHLDERR ); + + while ( my @fhs = $sel->can_read ) { + foreach my $fh ( @fhs ) { + if ( eof( $fh ) ) { + $sel->remove( $fh ); + + next; + } + + if ( fileno( $fh ) == fileno( *CHLDOUT ) ) { + my $line = <$fh>; + ( my $file = $line ) =~ s/.*\/|\n$//; + chomp( $line ); + chomp( $file ); + + if ( $oldpkg ) { + $oldpkg->{'files'} = [ + grep( $_ ne $line, + @{$oldpkg->{'files'}} ) + ]; + } + + if ( $file ) { + $cnt++; + + print "\e[KInstalling " + . "$self->{'name'}: $file\r"; + } + } + elsif ( fileno( $fh ) == fileno( *CHLDERR ) ) { + $stderr .= <$fh>; + } + } + } + + close( CHLDOUT ); + close( CHLDERR ); + + waitpid( $pid, 0 ); + $stat = $? >> 8; + + if ( $stat ) { + Snap->error( $stat, "Failed installing $self->{'name'}:" + . " $stderr\e[?25h" ); + } + + if ( $oldpkg ) { + foreach ( @{$oldpkg->{'files'}} ) { + if ( -f Snap->TARGET . "/$_" ) { + unlink( Snap->TARGET . "/$_" ) || + Snap->error( int( $? ), "unlink(): " + . Snap->TARGET + . "/$_: $!\e[?25h" ); + } + } + } + + $self->usher( 'postinst' ); + + open( AR, "ar p $self->{'path'} manifest|" ) || + Snap->error( int( $! ), "open(): $self->{'path'}: $!" ); + sysopen( MANIFEST, $manifest, O_RDWR|O_TRUNC|O_CREAT, 0644 ) || + Snap->error( int( $! ), "sysopen(): $manifest: $!" ); + + while ( ) { + print MANIFEST $_; + } + + close( MANIFEST ) || Snap->error( int( $! ), + "sysopen(): $manifest: $!" ); + close( AR ) || Snap->error( int( $! ), "open(): $manifest: $!" ); + + open( AR, "ar p $self->{'path'} snapinfo|" ) || + Snap->error( int( $! ), "open(): $self->{'path'}: $!" ); + sysopen( SNAPINFO, $snapinfo, O_RDWR|O_TRUNC|O_CREAT, 0644 ) || + Snap->error( int( $! ), "sysopen(): $snapinfo: $!" ); + + while ( ) { + print SNAPINFO $_; + } + + close( SNAPINFO ) || Snap->error( int( $! ), + "sysopen(): $snapinfo: $!" ); + close( AR ) || Snap->error( int( $! ), "open(): $self->{'path'}: $!" ); + + if ( $oldpkg ) { + unlink( "$snapinfo.$oldpkg->{'version'}" ) || + Snap->error( int( $! ), "unlink(): $snapinfo: $!" ); + unlink( "$manifest.$oldpkg->{'version'}" ) || + Snap->error( int( $! ), "unlink(): $manifest: $!" ); + } + + print "\e[KInstalling $self->{'name'}: DONE\e[?25h\n"; + } + +sub installed { + my $self = shift; + my $infofile; + + $infofile = Snap->INSTDIR . "/$self->{'name'}/snapinfo"; + + if ( -f $infofile ) { + my $snapinfo; + + open( SNAPINFO, "<$infofile" ) || + Snap->error( int( $! ), "open: $!" ); + + while ( ) { + if ( $_ =~ /^(\S+)\s*:\s*(.*)$/ ) { + $snapinfo->{$1} = $2; + } + } + + close( SNAPINFO ) || + Snap->error( int( $! ), "open: $!" ); + + if ( $self->{'name'} eq $snapinfo->{'name'} && + $self->{'version'} eq $snapinfo->{'version'} ) { + return( 1 ); + } + } + + return( 0 ); + } + +sub printbrief { + my $self = shift; + + if ( -t STDOUT ) { + printf( '%-12.12s ', $self->{'name'} ); + printf( '%-10.10s ', $self->{'version'} ); + printf( '%.58s', $self->{'brief'} || $self->{'description'} ); + } + else { + printf( '%-30.30s', $self->{'name'} ); + printf( '%-20.20s', $self->{'version'} ); + print $self->{'brief'} || $self->{'description'}; + } + + print "\n"; + } + +sub printself { + my $self = shift; + my @fields = qw( + name + version + depends + srcpkg + arch + status + bytes + url + path + source + repo + sha256 + sha256man + brief + description + ); + + foreach my $field ( @fields ) { + if ( $self->{$field} ) { + print "$field: $self->{$field}\n"; + } + } + } + +sub remove { + my $self = shift; + my $pkgdir = Snap->INSTDIR . "/$self->{'name'}"; + my $snapinfo = "$pkgdir/snapinfo"; + my $manifest = "$pkgdir/manifest"; + + $self->files( { quiet => 1, all => 1 } ); + + print "Removing $self->{'name'}... "; + + $self->usher( 'prerm' ); + + foreach ( @{$self->{'files'}} ) { + if ( -f Snap->TARGET . "/$_" ) { + unlink( Snap->TARGET . "/$_" ) || Snap->error( + int( $! ), "unlink(): " . Snap->TARGET + . "/$_: $!" ); + } + } + + $self->usher( 'postrm' ); + + unlink( $manifest ) || Snap->error( int( $! ), "unlink():" + . " $manifest: $!" ); + unlink( $snapinfo ) || Snap->error( int( $! ), "unlink():" + . " $snapinfo: $!" ); + + print "DONE\n"; + } + +sub revdeps { + my $self = shift; + my $sources = shift; + my $revdeps = shift; + my $opts = shift; + + foreach my $pkgname ( keys( %{$sources->{'installed'}} ) ) { + if ( $self->{'name'} eq $pkgname ) { + next; + } + + my $package = $sources->{'installed'}{$pkgname}; + my $chgver = 0; + + foreach my $depend ( split( /,/, $package->{'depends'} ) ) { + my ( $name, $req ) = split( /(((<|>)=?|=)(.*))/, + $depend ); + + if ( $self->{'name'} ne $name ) { + next; + } + elsif ( $opts->{'noreq'} && ! grep( $_->{'name'} eq + $package->{'name'}, @$revdeps ) ) { + $package->revdeps( $sources, $revdeps ); + push( @$revdeps, $package ); + + last; + } + elsif ( ! $req || grep( $_->{'name'} eq + $package->{'name'}, @$revdeps ) || + Snap->chkreq( $req, $self->{'version'} ) ) { + last; + } + + $chgver++; + + last; + } + + if ( ! $chgver ) { + next; + } + + foreach my $newpkg ( sort { Snap->vercmp( $a->{'version'}, + $b->{'version'} ) } @{$sources->{'pkgs'}{$pkgname}} ) { + foreach my $depend ( split( /,/, + $newpkg->{'depends'} ) ) { + my ( $name, $req ) = split( /(((<|>)=?|=)(.*))/, + $depend ); + + if ( $self->{'name'} ne $name ) { + next; + } + elsif ( ! $req || Snap->chkreq( $req, + $self->{'version'} ) ) { + $chgver = 0; + + last; + } + } + + if ( ! $chgver ) { + $newpkg->revdeps( $sources, $revdeps ); + push( @$revdeps, $newpkg ); + + last; + } + } + + if ( $chgver ) { + Snap->error( -1, "revdep(): Unable to find a version" + . " of $pkgname that is satisfied with" + . " $self->{'name'}=$self->{'version'}\n" ); + } + } + } + +sub usher { + my $self = shift; + my $action = shift; + my $usher = Snap->INSTDIR . "/$self->{'name'}/usher"; + my $pid; + my $sel; + my $stderr; + my $stat; + + if ( ! -f $usher || $action eq 'preinst' ) { + my $cnt = 0; + + eval { + $pid = open3( \*CHLDIN, \*CHLDOUT, \*CHLDERR, + "/usr/bin/ar p $self->{'path'} usher" ); + } || Snap->error( int( $! ), "open3():" + . " /usr/bin/ar: $!" ); + + close( CHLDIN ); + + $sel = IO::Select->new(); + $sel->add( *CHLDOUT, *CHLDERR ); + + sysopen( USHER, $usher, O_RDWR|O_TRUNC|O_CREAT, 0755 ) || + Snap->error( int( $! ), "sysopen(): $usher: $!" ); + + while ( my @fhs = $sel->can_read ) { + foreach my $fh ( @fhs ) { + if ( eof( $fh ) ) { + $sel->remove( $fh ); + + next; + } + + if ( fileno( $fh ) == fileno( *CHLDOUT ) ) { + my $line = <$fh>; + + if ( ! $cnt && $line =~ + /^no entry usher in archive$/ ) { + last; + } + + print USHER $line; + + $cnt++; + } + elsif ( fileno( $fh ) == fileno( *CHLDERR ) ) { + $stderr .= <$fh>; + } + } + } + + close( CHLDOUT ); + close( CHLDERR ); + close( USHER ); + + waitpid( $pid, 0 ); + $stat = $? >> 8; + + if ( $stat ) { + Snap->error( $stat, "Failed $self->{'name'}:" + . " $stderr\e[?25h" ); + } + + if ( ! $cnt && -f $usher ) { + unlink( $usher ); + } + } + + if ( ! -f $usher ) { + return; + } + + eval { + $pid = open3( \*CHLDIN, \*CHLDOUT, \*CHLDERR, + "TARGET=" . Snap->TARGET . " $usher $action" ); + } || Snap->error( int( $! ), "open3():" + . " $usher ($action): $!" ); + + close( CHLDIN ); + + $sel = IO::Select->new(); + $sel->add( *CHLDOUT, *CHLDERR ); + $sel = IO::Select->new(); + } + +############################################################ +# +# Might want to modify this... it doesn't currently work +# because the first shift gives you the class due to the +# fact that it must be called while specifying the namespace +# +# It has be modded on the central server only for now... +# +############################################################ + +sub sha256 { + my $pkgfile = shift; + my $digest = eval { + Digest::SHA->new( 256 )->addfile( $pkgfile ); + } || Snap->error( int( $! ), "sha256(): $pkgfile: $!" ); + + return( $digest->hexdigest ); + } + +1; diff --git a/SRC/snap/Snap.pm b/SRC/snap/Snap.pm new file mode 100644 index 0000000..ca633f6 --- /dev/null +++ b/SRC/snap/Snap.pm @@ -0,0 +1,735 @@ +package Snap; + +use strict; +use warnings; + +use Snap::Commands; +use Snap::Package; +use Snap::Sources; + +use Fcntl; +use IPC::Open3; +use IO::Socket::INET; +use Digest::SHA qw( sha256_hex ); +use POSIX; +use Data::Dumper; + +use parent 'Exporter'; +our @EXPORT = qw( + chkyes + error + genpkg + httpget + human + list + listfiles + readconf + refresh + setup + target + termsize + vercmp + ); + +use constant DEBUG => eval { + for ( my $i = 0; $i <= $#ARGV; $i++ ) { + if ( $ARGV[$i] eq '--debug' ) { + splice( @ARGV, $i, 1 ); + + return( 1 ); + } + } + + return( 0 ); + }; +use constant TARGET => eval { + my $target = ''; + + for ( my $i = 0; $i <= $#ARGV; $i++ ) { + if ( $ARGV[$i] eq '-t' ) { + $target = $ARGV[$i+1]; + + splice( @ARGV, $i, 2 ); + } + elsif ( $ARGV[$i] =~ /^-t(\S+)/ ) { + $target = $1; + + splice( @ARGV, $i, 1 ); + } + } + + $target =~ s/(\/+){2}/\//g; + $target =~ s/\/$//; + + return( $target ); + }; +use constant CONFFILE => eval { + if ( -f TARGET . '/etc/snap.conf' ) { + return( TARGET . '/etc/snap.conf' ); + } + elsif ( -f '/etc/snap.conf' ) { + return( '/etc/snap.conf' ); + } + else { + Snap->error( -1, 'No valid snap.conf found' ); + } + }; +use constant VERFILE => eval { + if ( -f TARGET . '/etc/snap_version' ) { + return( TARGET . '/etc/snap_version' ); + } + elsif ( -f '/etc/snap_version' ) { + return( '/etc/snap_version' ); + } + else { + Snap->error( -1, 'No valid snap_version found' ); + } + }; +use constant { + VERSION => '0.3', + SNAPDIR => TARGET . '/var/lib/snap', + PKGDIR => TARGET . '/var/lib/snap/packages', + INSTDIR => TARGET . '/var/lib/snap/installed', + SRCDIR => TARGET . '/var/lib/snap/sources' + }; +use constant SNAPVER => eval { + my $version; + + open( FILE, VERFILE ) || Snap->error( int( $! ), "open(): $!" ); + $version = ; + close( FILE ) || Snap->error( int( $! ), "open(): $!" ); + chomp( $version ); + + return( $version ); + }; + +############################################################ +# +# Set the process name +# +############################################################ + +$0 =~ s/.*\///; + +############################################################ +# +# Make sure we bring back the cursor if we're killed +# +############################################################ + +$SIG{INT} = sub{ + print "\e[?25h\n"; + + exit( -1 ); + }; + +############################################################ +# +# Export TARGET to the environment +# +############################################################ + +$ENV{TARGET} = TARGET; + +sub chkreq { + my $class = shift; + my $req = shift; + my $version = shift; + + if ( $req eq $version ) { + return( 1 ); + } + elsif ( $req && $req =~ /^((<|>)=?|=)\s*(.*)/ ) { + my $op = $1; + my $ver = $3; + my $chk = Snap->vercmp( $version, $ver ); + + if ( $op && + ( $op eq '<' && $chk == -1 ) || + ( $op eq '<=' && $chk <= 0 ) || + ( $op eq '>' && $chk == 1 ) || + ( $op eq '>=' && $chk >= 0 ) || + ( $op eq '=' && $chk == 0 ) ) { + return( 1 ); + } + } + + return( 0 ); + } + +sub chkyes { + my $yes = ''; + + while( ! $yes ){ + $yes = ; + chomp( $yes ); + + if ( lc( $yes ) eq 'n' ){ + print STDERR "\nAborting!\n\n"; + + exit 1; + } + elsif ( lc( $yes ne 'y' ) ){ + print "Answer 'y' or 'n': "; + + undef( $yes ); + } + } + } + +### error() ################################################ +# +# All errors should be sent here. This sub takes a status +# and error string as args. The status code is used as +# the exit code. This also iterates through the call stack +# which is dumped to STDERR +# +############################################################ + +sub error { + my $class = shift; + my $status = shift; + my $errstr = shift; + my $level = 1; + my @stack = (); + + chomp( $errstr ); + + print STDERR ( caller() )[1] .":\n $errstr at line " + . ( caller() )[2] . "\n"; + + if ( DEBUG ) { + if ( caller( $level ) ) { + print "\n=== Stack Trace ===\n"; + } + + while ( my @trace = caller( $level++ ) ) { + print STDERR " $trace[1]:\n" + . " $trace[3]() called at line $trace[2]\n"; + } + } + + print "\n"; + + if ( $status ) { + exit( $status ); + } + } + +### genpkg () ############################################## +# +# This sub generates a skeleton of directories and files +# that can be used as a starting point for creating a +# package. +# +############################################################ + +sub genpkg{ + my $pkgname = shift; + my $skelfile = '/usr/share/snap/Makefile.skel'; + my $snapreadme = "This is the directory where the manifest, snapinfo,\n" + . "and files.tar.gz files will be created. It is also\n" + . "where the usher file should be placed if it is\n" + . "required by the package. Any other files that need\n" + . "to be included could also be placed here.\n"; + my $patchreadme = "Place any patch files here and preface each with a\n" + . "number indicating the order of execution. Patch\n" + . "files are expected to use a .patch extension.\n"; + + mkdir( $pkgname, 0755 ) || + Snap->error( int( $! ), "mkdir: $pkgname: $!" ); + mkdir( "$pkgname/SNAP", 0755 ) || Snap->error( int( $! ), $! ); + mkdir( "$pkgname/SRC", 0755 ) || Snap->error( int( $! ), $! ); + mkdir( "$pkgname/SRC/patches", 0755 ) || Snap->error( int( $! ), $! ); + + open( SKEL, "<$skelfile" ) || Snap->error( int( $! ), $! ); + open( MAKEFILE, ">$pkgname/Makefile" ) || Snap->error( int( $! ), $! ); + + while ( ) { + print MAKEFILE $_; + } + + close( MAKEFILE ); + close( SKEL ); + + open( README, ">$pkgname/SNAP/README" ) || Snap->error( int( $! ), $! ); + print README $snapreadme; + close( README ); + + open( README, ">$pkgname/SRC/patches/README" ) + || Snap->error( int( $! ), $! ); + print README $patchreadme; + close( README ); + } + +sub httpget { + my $class = shift; + my $url = shift; + my $dest = shift; + my $mode = shift; + ( my $host = $url ) =~ s/^https?:\/\/|\/.*//g; + ( my $file = $url ) =~ s/.*$host//; + ( my $filename = $url ) =~ s/.*\///; + my %httpget = ( + 'status' => 0, + 'stdout' => '', + 'stderr' => '', + 'length' => 0, + 'type' => '', + 'dflag' => 0, + 'pct' => 0 + ); + my $sock = IO::Socket::INET->new( + PeerAddr => $host, + PeerPort => 'http(80)', + Proto => 'tcp' + ) || Snap->error( int( $! ), "IO::Socket::Inet->new(): $!" ); + my $bytes; + + local $| = 1; + + $sock->send( "GET $file HTTP/1.0\r\n" ); + $sock->send( "Host: $host\r\n" ); + $sock->send( "\r\n" ); + + if ( ! $mode ) { + $mode = '0644'; + } + + if ( $dest ) { + sysopen( DEST, $dest, O_RDWR|O_TRUNC|O_CREAT, $mode ) || + Snap->error( int( $! ), "sysopen(): $dest: $!" ); + + print "\e[?25l"; + } + + while ( <$sock> ) { + if ( $dest ) { + $bytes = ( stat( $dest ) )[7] || 0; + } + + 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'}++; + } + } + elsif ( $dest ) { + print DEST $_; + } + else { + $httpget{'stdout'} .= $_; + } + + if ( $dest && $httpget{'length'} && + $bytes < $httpget{'length'} ) { + if ( $bytes ) { + $httpget{'pct'} = int( $bytes / + $httpget{'length'} * 100 ); + } + + print "Retrieving $filename ["; + + for ( my $i = 0; $i < 20; $i++ ){ + if ( $i < $httpget{'pct'} / 5 ) { + print '*'; + } + else { + print ' '; + } + } + + print "] $httpget{'pct'}%\r"; + } + } + + if ( $dest ) { + print "Retrieving $filename [********************] 100%" + . "\e[?25h\n"; + + close( DEST ); + } + + close( $sock ); + chomp( $httpget{'stdout'} ); + + return( $httpget{'stdout'} ); + } + +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 list { + my $packages = {}; + my $package = {}; + + opendir( DIR, INSTDIR ) || Snap->error( -1, "opendir(): " + . INSTDIR . ": $!" ); + + foreach my $dir ( sort { $a cmp $b } readdir( DIR ) ) { + if ( $dir =~ /^\.{1,2}$/ || ! -f INSTDIR . "/$dir/snapinfo" ) { + next; + } + + open( SNAPINFO, "<", INSTDIR . "/$dir/snapinfo" ) + || Snap->error( int( $! ), "open: $!" ); + + while ( ) { + #################################### + # + # Temporary fix!!! Will need to + # remove after all packages are + # corrected... + # + #################################### + + $_ =~ s/^package:/name:/; + + if ( $_ =~ /^(\S+):\s+(.*)$/ ) { + $package->{$1} = $2; + } + } + + $packages->{$dir} = Snap::Package->new( $package ); + + close( SNAPINFO ); + } + + close( DIR ); + + return( $packages ); + } + +sub listfiles { + my $packages = list(); + my $listfiles = {}; + + foreach my $package ( @{$packages} ) { + my $manifest = Snap->INSTDIR + . "/$package->{'name'}/manifest"; + + open( MANIFEST, "<$manifest" ) || + Snap->error( int( $! ), "open(): $manifest: $!" ); + + while ( ) { + my ( $shasum, $perms, $file ) = split( /\s/, $_ ); + $listfiles->{$file}{'name'} = $package; + $listfiles->{$file}{'shasum'} = $shasum; + $listfiles->{$file}{'perms'} = $perms; + } + + close( MANIFEST ) || + Snap->error( int( $! ), "open(): $manifest: $!" ); + } + + return( $listfiles ); + } + +sub mkdirp{ + ( my $dir = shift ) =~ s/\/^//; + my $mode = shift; + ( my $parent = $dir ) =~ s/\/[^\/]+$//; + + if ( -d $dir ){ + return; + } + + mkdirp( $parent, $mode ); + + mkdir( $dir, $mode ) || Snap->error( int( $! ), "mkdir(): $dir: $!" ); + } + +### readconf() ############################################# +# +# reads CONFFILE and builds a data structure with the +# parsed values. Only the 'sources' section is treated +# in a special way - it is pushed into an array to maintain +# the order. This allows us to give priority to the topmost +# repositories +# +############################################################ + +sub readconf { + my $section = ''; + my $data = {}; + my $line = 0; + + open( FILE, "<", CONFFILE ) || Snap->error( int( $! ), + "open: " . CONFFILE . ": $!\n" ); + + while ( ) { + chomp( $_ ); + + if ( $_ =~ /^\s*#/ ) { + next; + } + elsif ( $_ =~ /\s*\[(\S+)\]\s*/ ) { + $section = $1; + + if ( $section eq 'sources' ) { + $data->{$section} = []; + } + } + elsif ( $section eq 'sources' && + $_ =~ /(\S+)\s*=\s*(.*)$/ ) { + push( @{$data->{$section}}, $_ ); + } + elsif ( $_ =~ /(\S+)\s*=\s*(.*)$/ ) { + $data->{$section}{$1} = $2; + } + } + + close( FILE ); + + return( $data ); + } + +### setup() ################################################ +# +# This should be called if any of the expected environment +# is found not to be present. This includes the directories +# in /var/lib/snap, /etc/snap.conf, and /etc/snap_version +# +############################################################ + +sub setup { + my $chkfails = 0; + my $target = 0; + my $snapdir = 0; + my $pkgdir = 0; + my $instdir = 0; + my $srcdir = 0; + my $yes = ''; + + if ( TARGET && ! -e TARGET ) { + $target++; + $chkfails++; + } + if ( ! -e SNAPDIR ) { + $snapdir++; + $chkfails++; + } + if ( ! -e PKGDIR ) { + $pkgdir++; + $chkfails++; + } + if ( ! -e INSTDIR ) { + $instdir++; + $chkfails++; + } + if ( ! -e SRCDIR ) { + $srcdir++; + $chkfails++; + } + + if ( $chkfails ) { + print "The following files/directories are missing: \n\n"; + } + else { + return; + } + + if ( $target ) { + print " " . TARGET . "\n"; + } + if ( $snapdir ) { + print " " . SNAPDIR . "\n"; + } + if ( $pkgdir ) { + print " " . PKGDIR . "\n"; + } + if ( $instdir ) { + print " " . INSTDIR . "\n"; + } + if ( $srcdir ) { + print " " . SRCDIR . "\n"; + } + + print "\n"; + + print "Create files/directories? (y/n): "; + + chkyes(); + + if ( $target ) { + mkdir( TARGET, 0755 ) || Snap->error( int( $! ), "mkdir: $!" ); + } + if ( $snapdir ) { + mkdirp( SNAPDIR, 0755 ); + } + if ( $pkgdir ) { + mkdir( PKGDIR, 0755 ) || Snap->error( int( $! ), + "mkdir(): " . PKGDIR . ": $!" ); + } + if ( $instdir ) { + mkdir( INSTDIR, 0755 ) || Snap->error( int( $! ), + "mkdir(): " . INSTDIR . ": $!" ); + } + if ( $srcdir ) { + my $conf = readconf(); + my $sources = Snap::Sources->new( $conf->{'sources'} ); + + mkdir( SRCDIR, 0755 ) || Snap->error( int( $! ), + "mkdir(): " . SRCDIR . ": $!" ); + + $sources->refresh(); + } + } + +### sha256() ############################################### +# +# This sub returns a hex sha256 hash of a supplied file +# +############################################################ + +sub sha256 { + my $class = shift; + my $file = shift; + my $digest = eval { + Digest::SHA->new( 256 )->addfile( $file ); + } || Snap->error( -1, "sha256(): $file: $!\n" ); + + return( $digest->hexdigest ); + } + +sub termsize { + require 'sys/ioctl.ph'; + my $data; + my $row; + my $col; + + open( TTY, "+error( 0, "No tty: $!" ); + + if ( ! ioctl( TTY, &TIOCGWINSZ, $data='' ) ) { + Snap->error( 0, "Failed to determine window size" ); + } + + close( TTY ); + + ( $row, $col ) = unpack( 'S4', $data ); + + return( { row => $row, col => $col } ); + } + +### 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 and license +# information 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. +# +# Return values: +# +# -1: A < B +# 0: match +# 1: A > B +# +############################################################ + +sub vercmp { + my $class = shift; + + 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; + } + +1; diff --git a/SRC/snap/Sources.pm b/SRC/snap/Sources.pm new file mode 100644 index 0000000..266a848 --- /dev/null +++ b/SRC/snap/Sources.pm @@ -0,0 +1,358 @@ +package Snap::Sources; + +use strict; +use warnings; + +use Compress::Zlib; +use Data::Dumper; + +use parent 'Snap'; + +sub new { + my $class = shift; + my $srcconf = shift; + my $sources = {}; + + foreach my $source ( @$srcconf ) { + if ( $source =~ /^(\S+)\s*=\s*(\S+?)\/*\s+(\S.*)$/ ) { + $sources->{'config'}{$1}{'url'} = "$2/" . Snap->SNAPVER; + $sources->{'config'}{$1}{'order'} = + keys( %{$sources->{'config'}} ); + + foreach ( split( /\s+/, $3 ) ) { + $sources->{'config'}{$1}{'repos'}{$_} = {}; + } + } + else { + Snap->error( int( $! ), "Snap::Sources->new():" + . " Invalid source format: $source" ); + } + } + + return( bless( $sources, $class ) ); + } + +sub readpkgs { + my $self = shift; + $self->{'installed'} = {}; + + foreach my $source ( sort { $self->{'config'}{$a}{'order'} <=> + $self->{'config'}{$b}{'order'} } ( keys( %{$self->{'config'}} ) ) ) { + my $repos = $self->{'config'}{$source}{'repos'}; + + foreach my $repo ( keys( %$repos ) ) { + my $repopath = "$self->{'config'}{$source}{'url'}" + . "/$repo"; + my $file = Snap->SRCDIR . "/$source/$repo-packages.gz"; + my $gz = gzopen( $file, 'r' ) || + Snap->error( int( $! ), "gzopen: $file: $!" ); + my $buff; + my $pkg = {}; + + while ( $gz->gzreadline( $buff ) ) { + if ( $buff =~ /^name:\s+(.*)$/ && + ! $self->{'pkgs'}{$1} ) { + $pkg->{'name'} = $1; + $self->{'pkgs'}{$1} = []; + } + elsif ( $buff =~ /^(\S+):\s+(.*)$/ ) { + $pkg->{$1} = $2; + } + elsif ( $buff =~ /^$/ && $pkg->{'name'} ) { + $pkg->{'source'} = $source; + $pkg->{'path'} = "$repopath" + . "/$pkg->{'path'}"; + + push( @{$self->{'pkgs'}{$pkg->{'name'}}} + ,Snap::Package->new( $pkg ) + ); + } + else { + Snap->error( -1, "Snap::Source->new:" + . "$file: malformed package" + . " list" ); + } + } + + $gz->gzclose(); + } + } + + opendir( DIR, Snap->INSTDIR ) || Snap->error( -1, "opendir(); " + . Snap->INSTDIR . ": $!" ); + + foreach my $dir ( readdir( DIR ) ) { + my $snapinfo = Snap->INSTDIR . "/$dir/snapinfo"; + my $package; + + if ( $dir =~ /^\.{1,2}$/ || ! -f $snapinfo ) { + next; + } + + $self->{'installed'}{$dir} = Snap::Package->new( $dir ); + } + + close( DIR ); + + return( 1 ); + } + +sub refresh { + my $self = shift; + my $cnt; + + foreach my $srcname ( sort { $self->{'config'}{$a}{'order'} <=> + $self->{'config'}{$b}{'order'} }( keys( %{$self->{'config'}} ) ) ) { + my $source = $self->{'config'}{$srcname}; + my $srcdir = Snap->SRCDIR . "/$srcname"; + + if ( ! -d $srcdir ) { + mkdir( $srcdir, 0755 ) || Snap->error( int( $! ), + "mkdir(): $srcdir: $!" ); + } + + if ( $cnt ) { + print "\n"; + } + + print "Refreshing $srcname\n"; + + foreach my $repo ( sort( keys( %{$source->{'repos'}} ) ) ) { + my $remotepkgs = "$source->{'url'}/" + . "/$repo-packages.gz"; + my $remotesha256 = "$source->{'url'}/" + . "/$repo-packages.gz.sha256"; + my $localpkgs = "$srcdir/$repo-packages.gz"; + my $shaget = Snap->httpget( $remotesha256, 0, 0644 ); + + Snap->httpget( $remotepkgs, $localpkgs, 0644 ); + + if ( Snap->sha256( $localpkgs ) ne $shaget ) { + Snap->error( -1, "sha256(): incorrect SHA256" + . " calculated for $localpkgs!" ); + } + } + + $cnt++; + } + } + +sub search { + my $self = shift; + my $opts = shift; + my $packages = []; + my $cnt; + + foreach my $pkgname ( sort( keys( %{$self->{'pkgs'}} ) ) ) { + my $package; + + if ( $opts->{'name'} && $pkgname ne $opts->{'name'} ) { + next; + } + + if ( $opts->{'version'} && ! $opts->{'name'} && + $opts->{'quiet'} ) { + Snap->error( -1, "$opts->{'version'}:" + . " missing package name" ); + } + + foreach ( sort { Snap->vercmp( $a->{'version'}, + $b->{'version'} ) } ( @{$self->{'pkgs'}{$pkgname}} ) ) { + if ( $opts->{'version'} && $opts->{'version'} =~ + /^((<|>)=?|=)\s*(.*)/ ) { + my $op = $1; + my $ver = $3; + my $chk = Snap->vercmp( $_->{'version'}, $ver ); + + if ( $op eq '<' && $chk != -1 ) { + next; + } + if ( $op eq '<=' && $chk > 0 ) { + next; + } + if ( $op eq '>' && $chk != 1 ) { + next; + } + if ( $op eq '>=' && $chk < 0 ) { + next; + } + if ( $op eq '=' && $chk != 0 ) { + next; + } + } + elsif ( $opts->{'version'} && $_->{'version'} ne + $opts->{'version'} ) { + next; + } + if ( $opts->{'depends'} && $_->{'depends'} !~ + /$opts->{'depends'}/ ) { + next; + } + if ( $opts->{'source'} && $_->{'source'} ne + $opts->{'source'} ) { + next; + } + if ( $opts->{'repo'} && $_->{'repo'} ne + $opts->{'repo'} ) { + next; + } + if ( $opts->{'string'} && ( $_->{'name'} !~ + /$opts->{'string'}/ && $_->{'description'} !~ + /$opts->{'string'}/ ) ) { + next; + } + + if ( $opts->{'all'} ) { + push( @$packages, $_ ); + } + elsif ( ! $package || Snap->vercmp( $_->{'version'}, + $package->{'version'} ) ) { + $package = $_; + } + } + + if ( $package ) { + push( @$packages, $package ); + } + } + + if ( ! @$packages ) { + if ( $opts->{'name'} && $opts->{'version'} ) { + Snap->error( 0, "Snap::Sources::search():" + . " $opts->{'name'}=$opts->{'version'}:" + . " No such package" ); + } + elsif ( $opts->{'name'} ) { + Snap->error( 0, "Snap::Sources::search():" + . " $opts->{'name'}: No such package" ); + } + elsif ( $opts->{'string'} ) { + Snap->error( 0, "Snap::Sources::search():" + . " No package matching '$opts->{'string'}'" ); + } + + return; + } + + if ( $opts->{'quiet'} ) { + if ( @$packages == 1 ) { + return( $packages->[0] ); + } + else { + return( $packages ); + } + } + + foreach my $package ( @$packages ) { + if ( $opts->{'verbose'} ) { + if ( $cnt ) { + print "\n"; + } + + $package->printself(); + + $cnt++; + } + else { + $package->printbrief(); + } + } + + return( 1 ); + } + +1; + +=head1 NAME + +Snap::Sources - Interface for Snaplinux package sources + +=head1 DESCRIPTION + +This module is not intended to be used directly, rather it is included with the parent Snap.pm module. It is separated into its own module only to logically separate the code. + +Snap::Sources includes all functions for retrieving, parsing, and searching through package lists. The structure of package objects is defined in Snap::Package. + +=head1 METHODS + +=head2 new + + $sources = Snap::Sources->new( $arrayref ) + +If $arrayref contains a list of valid sources the $sources object will be built. The $arrayref is intended to be populated with values parsed from /etc/snap.conf. The syntax for sources is as follows: + + [sources] + source1 = http://packages.snaplinux.org core dev util + +Each item listed under the [sources] section is added to $sources->{'config'}. The following describes the structure: + + $sources => { + config => { + source1 => { + url => 'http://packages.snaplinux.org/0.1', + order => 1, + repos => { + dev => {}, + core => {}, + util => {} + +=head2 readpkgs + + $sources->readpkgs() + +Parses all source/repo files and builds a list of packages which is available in $sources->{'pkgs'}. Also reads all installed packages and adds them to $sources->{'installed'}. The list is built with the following structure: + + $sources => { + pkgs => { + => [ + Snap::Package->{'version'} => 1 + Snap::Package->{'version'} => 2 + ] + } + installed => { + => Snap::Package + +=head2 search + + $sources->search( $searchterms ) + +This will search all sources and repos in the $sources object for the search terms and either print the output, or if { quiet => 1 } is supplied as an arg it will return the highest version of the matched package. The quiet option is only intended for internal routines rather than for queries intended to display output on the command line. + +Other available options that can be set (using key => value pairs): + +=over 4 + +=item name + +This will only return packages where the name matches exactly + +=item version + +The operators <, <=, >, >=, = can all be used to retrieve the desired package version. The operator should preface the version string. + +=item depends + +The supplied string will be used as a patter to match dependencies in packages. + +=item source + +Return only packages available from the specified source. + +=item repo + +Return only packages from the specified repo + +=item string + +The supplied string will be used to match against either the package name, or the package description. + +=back + +=head2 refresh + + $sources->refresh() + +This will download all package information for the repos defined in $sources->{'config'}. The data will be stored in /var/lib/snap/sources/ + +=cut + diff --git a/SRC/snap/group b/SRC/snap/group deleted file mode 100644 index 9e65e34..0000000 --- a/SRC/snap/group +++ /dev/null @@ -1,22 +0,0 @@ -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/passwd b/SRC/snap/passwd deleted file mode 100644 index 757a665..0000000 --- a/SRC/snap/passwd +++ /dev/null @@ -1,5 +0,0 @@ -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/snap b/SRC/snap/snap index d38aced..c69350f 100755 --- a/SRC/snap/snap +++ b/SRC/snap/snap @@ -1,2049 +1,549 @@ #!/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 Snap; use Data::Dumper; ############################################################ # -# Set the process name +# setup() will give the user the option to create the files +# and directories needed for snap to function # ############################################################ -$0 =~ s/.*\///; +setup(); -my $snapver; -my $conffile = '/etc/snap.conf'; -my $conf = readconf( $conffile ); +my $command = shift( @ARGV ); +my $conf = readconf(); +my $commands = Snap::Commands->new(); +my $sources = Snap::Sources->new( $conf->{'sources'} ); -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 ); +if ( $ARGV[0] && $ARGV[0] eq '-h' ) { + $commands->commandhelp( $command ); } +elsif ( $command eq 'genpkg' ) { + foreach my $arg ( @ARGV ) { + genpkg( $arg ); + } + } +elsif ( $command eq 'files' ) { + my $opts = { + all => eval { + for ( my $i = 0; $i <= $#ARGV; $i++ ) { + if ( $ARGV[$i] eq '-a' ) { + splice( @ARGV, $i, 1 ); -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; + return( 1 ); + } + } + }, + verbose => eval { + for ( my $i = 0; $i <= $#ARGV; $i++ ) { + if ( $ARGV[$i] eq '-v' ) { + splice( @ARGV, $i, 1 ); - 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; + return( 1 ); } } } - } - - 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'} ) ) { - if ( ! grep( /^$depend$/, @$depends ) ) { - push( @$depends, $depend ); - depends( $packages, $depend, $depends ); - } - } - } - } - -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: $!"; + my $string = "@ARGV"; - return( \%httpget ); - }; + print "\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; + foreach my $arg ( @ARGV ) { + my $package = Snap::Package->new( $arg ); - 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 $_; + $package->files( $opts ); } - close( $sock ); - close( DEST ); - - return( \%httpget ); + print "\n"; } - -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 ); +elsif ( $command eq 'help' ) { + $commands->help(); } +elsif ( $command eq 'info' ) { -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; + print "\n"; - if ( ! -f $pkgfile && -f "$pkgdir/snapinfo" ){ - my $snapinfo = "$pkgdir/snapinfo"; + foreach my $arg ( @ARGV ) { + my $package = Snap::Package->new( $arg ); - 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[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( $pkgfile ); - - 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"; - - %result = 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 ); - } - } - - for ( my $i = $#depends; $i >= 0; $i-- ) { - my $depend = $depends[$i]; - 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', ' ' ); - } + $package->printself(); print "\n"; } } -elsif ( $ARGV[0] eq 'list' ){ - my $result = list( $ARGV[1], $ARGV[2] || '' ); - my $list = $result->{'list'}; +elsif ( $command eq 'install' ) { + my @attribs = qw( source repo ); + my $opts = { + nodeps => eval { + for ( my $i = 0; $i <= $#ARGV; $i++ ) { + if ( $ARGV[$i] eq '--no-deps' ) { + splice( @ARGV, $i, 1 ); - if ( $result->{'status'} ){ - print "snap Error: $result->{'stderr'}\n"; + return( 1 ); + } + } + }, + quiet => 1, + yes => eval { + for ( my $i = 0; $i <= $#ARGV; $i++ ) { + if ( $ARGV[$i] eq '-y' ) { + splice( @ARGV, $i, 1 ); - exit $result->{'status'}; + return( 1 ); + } + } + } + }; + my $string = "@ARGV"; + my $packages = []; + my $bytes = 0; + + foreach my $attrib ( @attribs ) { + if ( $string =~ /$attrib\s*:\s*(\S+)/ ) { + $opts->{$attrib} = $1; + + $string =~ s/$attrib\s*:\s*(\S+)? //; + } } - foreach my $row ( @$list ){ - if ( $row->{'type'} eq 'd' ){ + print "\n"; + + $sources->readpkgs(); + + #################################################### + # + # This loop replaces source packages with any + # package files supplied on the command line. + # + # This allows the user to override the source + # with local packages. + # + #################################################### + + foreach my $arg ( split( /\s/, $string ) ) { + if ( -f $arg ) { + my $package = Snap::Package->new( $arg ); + $sources->{'pkgs'}{$package->{'name'}} = []; + push( @{$sources->{'pkgs'}{$package->{'name'}}}, + $package ); + } + } + + foreach my $arg ( split( /\s/, $string ) ) { + my $package; + + if ( ! -f $arg ) { + my ( $name, $version ) = split( /(((<|>)=?|=)(.*))/, + $arg ); + $opts->{'name'} = $name; + $opts->{'version'} = $version; + + $package = $sources->search( $opts ); + } + else { + $package = Snap::Package->new( $arg ); + } + + if ( ! $package ) { + Snap->error( -1, "$arg: No such package found" ); + } + + if ( ! $opts->{'nodeps'} ) { + print "Resolving dependencies for" + . " $package->{'name'}\n"; + + $package->depends( $sources, $packages ); + } + else { + print "Ignoring dependencies for $package->{'name'}\n"; + } + + push( @$packages, $package ); + } + + #################################################### + # + # Here we iterate through all installed packages + # and add their file lists. This will later be + # checked against for conflicts. + # + #################################################### + + foreach my $pkgname ( sort { $sources->{'installed'}{$a}{'name'} cmp + $sources->{'installed'}{$b}{'name'} } + keys( %{$sources->{'installed'}} ) ) { + $sources->{'installed'}{$pkgname}->files( { quiet => 1 } ); + } + + for ( my $i = 0; $i <= $#$packages; $i++ ) { + my $snapinfo = Snap->INSTDIR . "/$packages->[$i]{'name'}/" + . "snapinfo"; + my $version; + my $oldbytes; + my $chk; + + if ( $packages->[$i]{'path'} =~ /https*:\/\// ) { + ( my $filename = $packages->[$i]{'path'} ) =~ s/.*\///; + + if ( ! -f Snap->PKGDIR . "/$filename" ) { + Snap->httpget( $packages->[$i]{'path'}, + Snap->PKGDIR . "/$filename", 0644 ); + } + + $packages->[$i]{'path'} = Snap->PKGDIR . "/$filename"; + } + + if ( ! -f $snapinfo ) { + $packages->[$i]{'status'} = 'installing'; + $bytes += $packages->[$i]{'bytes'}; + + $packages->[$i]->conflicts( $sources ); + next; } - print "$row->{'sha256'}\t$row->{'file'}\n"; + open( SNAPINFO, "<$snapinfo" ) || Snap->error( int( $! ), + "open(): $snapinfo: $!" ); + + while ( ) { + if ( $_ =~ /version:\s*(.*)$/ ) { + $version = $1; + } + if ( $_ =~ /bytes:\s*(.*)$/ ) { + $oldbytes = $1; + } + } + + close( SNAPINFO ); + + $chk = Snap->vercmp( $version, $packages->[$i]{'version'} ); + + if ( $chk == -1 ) { + $packages->[$i]{'status'} = 'upgrading'; + $bytes -= $oldbytes; + } + elsif ( $chk == 0 ) { + print "Package $packages->[$i]{'name'}=" + . "$packages->[$i]{'version'}" + . " is already installed\n"; + + splice( @$packages, $i, 1 ); + + $i--; + + next; + } + elsif ( $chk == 1 ) { + $packages->[$i]{'status'} = 'downgrading'; + $bytes -= $oldbytes; + } + + $packages->[$i]->conflicts( $sources ); + $bytes += $packages->[$i]{'bytes'}; } - } -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 ) { + print "\nNothing to do\n\n"; - if ( $packages->{'status'} != 200 ) { - print "Failed!\nhttpget: $packages->{'stderr'}\n"; + exit; + } + + foreach my $status ( qw( installing upgrading downgrading ) ) { + my $termsize = Snap->termsize(); + my $cnt = 0; + + foreach my $package ( sort { $a->{'name'} cmp $b->{'name'} } + ( @$packages ) ) { + if ( $package->{'status'} ne $status ) { + next; + } + + if ( ! $cnt ) { + print "\nThe following packages will be"; + } + + if ( ! $cnt && $status eq 'installing' ) { + print " installed:\n "; + } + elsif ( ! $cnt && $status eq 'upgrading' ) { + print " upgraded:\n "; + } + elsif ( ! $cnt && $status eq 'downgrading' ) { + print " downgraded:\n "; + } + + if ( $termsize->{'col'} - ( length( + $package->{'name'} ) + 3 ) <= 0 ) { + print "\n "; + + $termsize = Snap->termsize(); + } + + print "$package->{'name'} "; + + $termsize->{'col'} -= length( $package->{'name'} ) + 1; + $cnt++; } } - } -elsif ( $ARGV[0] eq 'remove' ){ - my $result = remove( @ARGV ); - if ( $result->{'status'} ){ - print STDERR "snap Error: $result->{'stderr'}\n"; + print "\n\nInstall will require " . human( $bytes ) + . ". Continue? (y/n): "; - exit $result->{'status'}; + chkyes(); + + print "\n"; + + foreach my $package ( @$packages ) { + $package->install( $sources ); } - else{ - print "\nPackage successfully removed\n\n"; + + print "\n"; + } +elsif ( $command eq 'list' ) { + my $packages = list(); + + print "\n"; + + foreach my $package ( sort( keys( %$packages ) ) ) { + $packages->{$package}->printbrief(); + } + + print "\n"; + } +elsif ( $command eq 'refresh' ) { + print "\n"; + + $sources->refresh(); + + print "\n"; + exit; + + foreach my $source ( @{$conf->{'sources'}} ) { + print "Updating package list for $source->{'name'}\n"; + + Snap::Sources->refresh( $source ); + + print "\n"; } } -elsif ( $ARGV[0] eq 'repo' ) { - my $packages = repo( $ARGV[1] || '' ); +elsif ( $command eq 'remove' ) { + my $opts = { + nodeps => eval { + for ( my $i = 0; $i <= $#ARGV; $i++ ) { + if ( $ARGV[$i] eq '--no-deps' ) { + splice( @ARGV, $i, 1 ); - foreach my $package ( sort( keys( %{$packages} ) ) ) { - print "$package - $packages->{$package}{'description'}\n"; - } - } -elsif ( $ARGV[0] eq 'search' ) { - my $packages = repo(); + return( 1 ); + } + } + }, + quiet => 1, + yes => eval { + for ( my $i = 0; $i <= $#ARGV; $i++ ) { + if ( $ARGV[$i] eq '-y' ) { + splice( @ARGV, $i, 1 ); - 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"; + return( 1 ); + } + } + } + }; + my $string = "@ARGV"; + my $packages = []; + my $bytes = 0; + my $cnt = 0; + my $termsize = Snap->termsize(); + + print "\n"; + + $sources->readpkgs(); + + foreach my $arg ( split( /\s/, $string ) ) { + my $package = Snap::Package->new( $arg ); + + if ( ! $package ) { + Snap->error( -1, "$arg: No such package found" ); + } + + if ( ! $opts->{'nodeps'} ) { + print "Resolving reverse dependencies for" + . " $package->{'name'}\n"; + + $package->revdeps( $sources, $packages, + { noreq => 1 } ); + } + else { + print "Ignoring reverse dependencies for" + . " $package->{'name'}\n"; + } + + if ( ! grep( $_->{'name'} eq $package->{'name'}, + @$packages ) ) { + push( @$packages, $package ); } } - } -else{ - print STDERR "snap Error: $ARGV[0] is not a valid argument\n"; - exit 1; + foreach my $package ( sort { $a->{'name'} cmp $b->{'name'} } + ( @$packages ) ) { + if ( ! $cnt ) { + print "\nThe following packages will be removed:\n "; + } + + if ( $termsize->{'col'} - ( length( + $package->{'name'} ) + 3 ) <= 0 ) { + print "\n "; + + $termsize = Snap->termsize(); + } + + print "$package->{'name'} "; + + $termsize->{'col'} -= length( $package->{'name'} ) + 1; + $cnt++; + + $bytes += $package->{'bytes'}; + } + + print "\n\n" . human( $bytes ) . " will be recovered." + . " Continue? (y/n): "; + + chkyes(); + + print "\n"; + + foreach my $package ( @$packages ) { + $package->remove( $sources ); + } + + print "\n"; + } +elsif ( $command eq 'revdep' ) { + my $revdeps = []; + + print "\n"; + + $sources->readpkgs(); + + foreach my $arg ( @ARGV ) { + my $package = Snap::Package->new( $arg ); + + $package->revdeps( $sources, $revdeps, { noreq => 1 } ); + } + + foreach ( sort { $a->{'name'} cmp $b->{'name'} } ( @$revdeps ) ) { + print "$_->{'name'}\n"; + } + + if ( ! @$revdeps ) { + print "No reverse dependencies found\n"; + } + + print "\n"; + } +elsif ( $command eq 'search' ) { + my @attribs = qw( name version depends source repo description ); + my $opts = { + all => eval { + for ( my $i = 0; $i <= $#ARGV; $i++ ) { + if ( $ARGV[$i] eq '-a' ) { + splice( @ARGV, $i, 1 ); + + return( 1 ); + } + } + }, + verbose => eval { + for ( my $i = 0; $i <= $#ARGV; $i++ ) { + if ( $ARGV[$i] eq '-v' ) { + splice( @ARGV, $i, 1 ); + + return( 1 ); + } + } + } + }; + my $string = "@ARGV"; + + foreach my $attrib ( @attribs ) { + if ( $string =~ /$attrib\s*:\s*(\S+)/ ) { + $opts->{$attrib} = $1; + + $string =~ s/$attrib\s*:\s*(\S+)//; + } + } + + if ( ! $opts->{'name'} && ! $opts->{'version'} && + $string =~ /(\S+)\s*=\s*(\S+)/ ) { + $opts->{'name'} = $1; + $opts->{'version'} = $2; + $string =~ s/(\S+)\s*=\s*(\S+)//; + } + + if ( $string ) { + ( $opts->{'string'} = $string ) =~ s/^ *| *$//g; + } + + print "\n"; + + if ( ! $sources->readpkgs() ) { + exit -1; + } + + if ( ! $sources->search( $opts ) ) { + exit -1; + } + + print "\n"; + } +elsif ( $command eq 'setup' ) { + my $opts = { + repo => 'core', + quiet => 1 + }; + my $packages; + + print "\n"; + + if ( ! Snap->TARGET ) { + Snap->error( -1, 'A target must be specified with -t' ); + } + + $sources->readpkgs(); + $packages = $sources->search( $opts ); + + for ( my $i = 0; $i <= $#$packages; $i++ ) { + if ( $packages->[$i]{'name'} eq 'snap-base' ) { + unshift( @$packages, $packages->[$i] ); + splice( @$packages, $i+1, 1 ); + } + } + + foreach my $package ( @$packages ) { + $package->install(); + } + + print "\n"; + } +elsif ( $command eq 'verify' ) { + foreach my $arg ( @ARGV ) { + my $package = Snap::Package->new( $arg ); + + print Dumper( $package ); + } + } +elsif ( $command ) { + print "\n"; + + Snap->error( -1, "'$command': Invalid command" ); + } +else { + Snap->error( 0, "You must supply a command" ); + + $commands->help(); } diff --git a/SRC/snap/snap.conf b/SRC/snap/snap.conf deleted file mode 100644 index 76e5204..0000000 --- a/SRC/snap/snap.conf +++ /dev/null @@ -1,6 +0,0 @@ -[general] -snapdir = var/snap -pkgfile = packages.gz - -[sources] -default = http://packages.snaplinux.org/ diff --git a/SRC/snap/snap.inprogress b/SRC/snap/snap.inprogress deleted file mode 100644 index 852b4da..0000000 --- a/SRC/snap/snap.inprogress +++ /dev/null @@ -1,2060 +0,0 @@ -#!/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/snap_version b/SRC/snap/snap_version deleted file mode 100644 index 68efb73..0000000 --- a/SRC/snap/snap_version +++ /dev/null @@ -1 +0,0 @@ -0.0alpha0