Completely re-written to be more modular (hopefully easier to follow):
* Separated logic in Snap.pm, Commands.pm, Package.pm, and Sources.pm * Removed usher creation of directory structure (now in files.tar.gz) * Files like /etc/passwd now handled by snap-base
This commit is contained in:
9
Makefile
9
Makefile
@@ -8,15 +8,15 @@
|
|||||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
# GNU General Public License for more details.
|
# 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
|
ARCH = x86_64
|
||||||
URL =
|
URL =
|
||||||
DESC = This is the base of the snaplinux system
|
DESC = The Snaplinux package management system
|
||||||
|
|
||||||
ARCHIVE := ''
|
ARCHIVE := ''
|
||||||
SRCDIR := $(PWD)/SRC/snap
|
SRCDIR := $(PWD)/SRC/snap
|
||||||
PATCHDIR := $(PWD)/SRC/patches
|
PATCHDIR := $(PWD)/SRC/patches
|
||||||
VERSION := 0.2sr1
|
VERSION := 0.4-0
|
||||||
|
|
||||||
MAKEINST = make install
|
MAKEINST = make install
|
||||||
|
|
||||||
@@ -29,8 +29,7 @@ $(ROOT): $(SRCDIR)/Makefile
|
|||||||
mkdir -v $(ROOT); \
|
mkdir -v $(ROOT); \
|
||||||
fi
|
fi
|
||||||
|
|
||||||
@cd $(SRCDIR); \
|
@cd $(SRCDIR) && $(MAKEINST) DESTDIR=$(ROOT)
|
||||||
$(MAKEINST) DESTDIR=$(ROOT)
|
|
||||||
|
|
||||||
clean:
|
clean:
|
||||||
@rm -rvf $(ROOT) \
|
@rm -rvf $(ROOT) \
|
||||||
|
|||||||
87
SNAP/usher
87
SNAP/usher
@@ -2,94 +2,9 @@
|
|||||||
|
|
||||||
set -e
|
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
|
case $1 in
|
||||||
preinst)
|
preinst)
|
||||||
echo "Creating base directory structure"
|
exit 0
|
||||||
install -d -m 755 ${TARGET}/etc/{ld.so,conf.d,opt}
|
|
||||||
install -d -m 755 ${TARGET}/usr/bin
|
|
||||||
install -d -m 755 ${TARGET}/bin
|
|
||||||
install -d -m 755 ${TARGET}/boot
|
|
||||||
install -d -m 755 ${TARGET}/dev
|
|
||||||
install -d -m 755 ${TARGET}/home
|
|
||||||
install -d -m 755 ${TARGET}/lib
|
|
||||||
install -d -m 755 ${TARGET}/media/{cdrom,floppy}
|
|
||||||
install -d -m 755 ${TARGET}/mnt
|
|
||||||
install -d -m 755 ${TARGET}/opt
|
|
||||||
install -d -m 755 ${TARGET}/proc
|
|
||||||
install -d -m 750 ${TARGET}/root
|
|
||||||
install -d -m 755 ${TARGET}/run/lock
|
|
||||||
install -d -m 755 ${TARGET}/sbin
|
|
||||||
install -d -m 755 ${TARGET}/srv
|
|
||||||
install -d -m 755 ${TARGET}/sys
|
|
||||||
install -d -m 1777 ${TARGET}/tmp
|
|
||||||
install -d -m 755 ${TARGET}/usr/{bin,include,lib,libexec,local}
|
|
||||||
install -d -m 755 ${TARGET}/usr/local/{bin,include,lib,sbin,share}
|
|
||||||
install -d -m 755 \
|
|
||||||
${TARGET}/usr/local/share/{color,dict,doc,info,locale,man}
|
|
||||||
install -d -m 755 ${TARGET}/usr/local/share/man/man{1..8}
|
|
||||||
install -d -m 755 ${TARGET}/usr/local/share/{misc,terminfo,zoneinfo}
|
|
||||||
install -d -m 755 ${TARGET}/usr/local/src
|
|
||||||
install -d -m 755 ${TARGET}/usr/{sbin,share}
|
|
||||||
install -d -m 755 ${TARGET}/usr/share/{color,dict,doc,info,locale}
|
|
||||||
install -d -m 755 ${TARGET}/usr/share/man/man{1..8}
|
|
||||||
install -d -m 755 ${TARGET}/usr/share/{misc,snap,terminfo,zoneinfo}
|
|
||||||
install -d -m 755 ${TARGET}/usr/src
|
|
||||||
install -d -m 755 ${TARGET}/var/cache/nscd
|
|
||||||
install -d -m 755 ${TARGET}/var/lib/{color,locate,misc}
|
|
||||||
install -d -m 755 ${TARGET}/var/{local,log,mail,opt,snap,spool}
|
|
||||||
install -d -m 1777 ${TARGET}/var/tmp
|
|
||||||
install -m 600 /dev/null ${TARGET}/var/log/btmp
|
|
||||||
install -m 644 /dev/null ${TARGET}/var/log/wtmp
|
|
||||||
install -m 664 /dev/null ${TARGET}/var/log/lastlog
|
|
||||||
ln -sf /proc/self/mounts ${TARGET}/etc/mtab
|
|
||||||
ln -sf lib ${TARGET}/lib64
|
|
||||||
ln -sf lib ${TARGET}/usr/lib64
|
|
||||||
ln -sf lib ${TARGET}/usr/local/lib64
|
|
||||||
ln -sf /run/lock ${TARGET}/var/lock
|
|
||||||
ln -sf /run ${TARGET}/var/run
|
|
||||||
|
|
||||||
if [ ! -f ${TARGET}/etc/resolv.conf ]&&[ -f /etc/resolv.conf ]; then
|
|
||||||
echo "Copying resolv.conf from temporary system"
|
|
||||||
cp /etc/resolv.conf ${TARGET}/etc/resolv.conf
|
|
||||||
fi
|
|
||||||
|
|
||||||
if [ ! -f ${TARGET}/etc/passwd ]; then
|
|
||||||
echo "Creating /etc/passwd"
|
|
||||||
echo "${PASSWD}" > ${TARGET}/etc/passwd
|
|
||||||
fi
|
|
||||||
if [ ! -f ${TARGET}/etc/group ]; then
|
|
||||||
echo "Creating /etc/group"
|
|
||||||
echo "${GROUP}" > ${TARGET}/etc/group
|
|
||||||
fi
|
|
||||||
;;
|
;;
|
||||||
postinst)
|
postinst)
|
||||||
setpass=`cat ${TARGET}/etc/shadow|grep ^root|awk -F':' '{print $2}'`
|
setpass=`cat ${TARGET}/etc/shadow|grep ^root|awk -F':' '{print $2}'`
|
||||||
|
|||||||
258
SRC/snap/Commands.pm
Normal file
258
SRC/snap/Commands.pm
Normal file
@@ -0,0 +1,258 @@
|
|||||||
|
package Snap::Commands;
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
|
||||||
|
use parent 'Snap';
|
||||||
|
|
||||||
|
my $commands = {
|
||||||
|
files => {
|
||||||
|
options => [
|
||||||
|
'<PKGNAME|FILE>',
|
||||||
|
'[-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 => [
|
||||||
|
'<PKGNAME>'
|
||||||
|
],
|
||||||
|
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 => [
|
||||||
|
'<PKGNAME[=VER]|FILE>',
|
||||||
|
'[-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 => [
|
||||||
|
'<PKGNAME[=VER]|FILE>',
|
||||||
|
'[-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 => [
|
||||||
|
'<PKGNAME>',
|
||||||
|
'[-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 => [
|
||||||
|
'<PKGNAME>',
|
||||||
|
'[-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 => [
|
||||||
|
'<PKGNAME>',
|
||||||
|
'[-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 => [
|
||||||
|
'<PKGNAME[=VER]>'
|
||||||
|
],
|
||||||
|
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 <COMMAND> <ARGS>\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 <COMMAND> -h\n\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
||||||
@@ -1,12 +1,21 @@
|
|||||||
dirs:
|
dirs:
|
||||||
install -d -v -m 755 $(DESTDIR)/etc
|
install -d -v -m 755 $(DESTDIR)/etc
|
||||||
install -d -v -m 755 $(DESTDIR)/usr/{bin,share/snap}
|
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:
|
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 755 snap $(DESTDIR)/usr/bin/snap
|
||||||
|
install -v -m 644 Makefile.skel \
|
||||||
|
$(DESTDIR)/usr/share/snap/Makefile.skel
|
||||||
install -v -m 644 Makefile.snaplinux \
|
install -v -m 644 Makefile.snaplinux \
|
||||||
$(DESTDIR)/usr/share/snap/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
|
install: dirs files
|
||||||
|
|||||||
75
SRC/snap/Makefile.skel
Normal file
75
SRC/snap/Makefile.skel
Normal file
@@ -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)
|
||||||
|
|
||||||
@@ -19,6 +19,15 @@ MANIFEST = $(SNAPDIR)/manifest
|
|||||||
USHER = $(SNAPDIR)/usher
|
USHER = $(SNAPDIR)/usher
|
||||||
FILES = $(SNAPDIR)/files.tar.gz
|
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
|
# The following values must be set in the Makefile for the package
|
||||||
|
|
||||||
ifndef VERSION
|
ifndef VERSION
|
||||||
@@ -42,16 +51,18 @@ $(SNAP): $(SNAPINFO) $(FILES)
|
|||||||
$(SNAPINFO): $(MANIFEST)
|
$(SNAPINFO): $(MANIFEST)
|
||||||
@>$(SNAPINFO)
|
@>$(SNAPINFO)
|
||||||
$(eval BYTES := $(shell gzip -l $(FILES)|tail -1|awk '{print $$2}'))
|
$(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 "name: $(PACKAGE)\nversion: $(VERSION)\n" > $(SNAPINFO) && \
|
||||||
printf "depends: $(DEPENDS)\narch: $(ARCH)\nbytes: $(BYTES)\n" \
|
printf "depends: $(DEPENDS)\narch: $(ARCH)\n" >> $(SNAPINFO) && \
|
||||||
>> $(SNAPINFO) && \
|
printf "srcpkg: $(SRCPKG)\nbytes: $(BYTES)\n" >> $(SNAPINFO) && \
|
||||||
printf "url: $(URL)\ndescription: $(DESC)\n" >> $(SNAPINFO)
|
printf "url: $(URL)\nsha256man: $(SHA256MAN)\n" >> $(SNAPINFO) && \
|
||||||
|
printf "brief: $(BRIEF)\ndescription: $(DESC)" >> $(SNAPINFO)
|
||||||
|
|
||||||
$(MANIFEST): $(FILES)
|
$(MANIFEST): $(FILES)
|
||||||
@>$(MANIFEST)
|
@>$(MANIFEST)
|
||||||
|
|
||||||
rootfiles=`cd $(ROOT) && find ! -path .|sed 's/^\.\///'|sort -r`; \
|
@rootfiles=`cd $(ROOT) && find ! -path .|sed 's/^\.\///'|sort -r` && \
|
||||||
while read -r file; do \
|
while read -r file; do \
|
||||||
info=`ls -ld "$(ROOT)/$$file"`; \
|
info=`ls -ld "$(ROOT)/$$file"`; \
|
||||||
perm=`echo $$info|awk '{print $$1}'`; \
|
perm=`echo $$info|awk '{print $$1}'`; \
|
||||||
@@ -69,9 +80,32 @@ $(MANIFEST): $(FILES)
|
|||||||
$(FILES): $(ROOT)
|
$(FILES): $(ROOT)
|
||||||
# Remove any perllocal.pod to avoid conflicts
|
# Remove any perllocal.pod to avoid conflicts
|
||||||
# Should try to properly fix this some time...
|
# Should try to properly fix this some time...
|
||||||
|
|
||||||
@find $(ROOT) -name perllocal.pod -exec rm {} \;
|
@find $(ROOT) -name perllocal.pod -exec rm {} \;
|
||||||
|
|
||||||
|
@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 \
|
@find $(ROOT) -type f | while read -r file; do \
|
||||||
type=`file -i $$file|sed 's/.*: //'`; \
|
type=`file -i $$file|sed 's/.*: //'`; \
|
||||||
case $$type in \
|
case $$type in \
|
||||||
@@ -79,12 +113,13 @@ $(FILES): $(ROOT)
|
|||||||
strip --strip-unneeded $$file \
|
strip --strip-unneeded $$file \
|
||||||
;; \
|
;; \
|
||||||
*'/x-object; charset=binary') \
|
*'/x-object; charset=binary') \
|
||||||
strip --strip-debug $$file \
|
strip --strip-unneeded $$file \
|
||||||
;; \
|
;; \
|
||||||
*'/x-sharedlib; charset=binary') \
|
*'/x-sharedlib; charset=binary') \
|
||||||
strip --strip-debug $$file \
|
strip --strip-unneeded $$file \
|
||||||
;; \
|
;; \
|
||||||
esac; \
|
esac; \
|
||||||
done
|
done; \
|
||||||
|
fi
|
||||||
@cd $(ROOT) && tar cvzf $(FILES) *
|
@cd $(ROOT) && tar cvzf $(FILES) *
|
||||||
|
|
||||||
|
|||||||
840
SRC/snap/Package.pm
Normal file
840
SRC/snap/Package.pm
Normal file
@@ -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( <SNAPINFO> ) {
|
||||||
|
####################################
|
||||||
|
#
|
||||||
|
# Temporary fix!!! Will need to
|
||||||
|
# remove after all packages are
|
||||||
|
# corrected...
|
||||||
|
#
|
||||||
|
####################################
|
||||||
|
|
||||||
|
$_ =~ s/^package:/name:/;
|
||||||
|
|
||||||
|
if ( $_ = /^(\S+):\s+(.*)$/ ) {
|
||||||
|
$self->{$1} = $2;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
close( SNAPINFO ) ||
|
||||||
|
Snap->error( int( $! ), "close(): $infofile: $!" );
|
||||||
|
|
||||||
|
$self->{'status'} = 'installed';
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
Snap->error( -2, "'$package': No such file or package found" );
|
||||||
|
}
|
||||||
|
|
||||||
|
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 ( <MANIFEST> ) {
|
||||||
|
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 ( <AR> ) {
|
||||||
|
print MANIFEST $_;
|
||||||
|
}
|
||||||
|
|
||||||
|
close( MANIFEST ) || Snap->error( int( $! ),
|
||||||
|
"sysopen(): $manifest: $!" );
|
||||||
|
close( AR ) || Snap->error( int( $! ), "open(): $manifest: $!" );
|
||||||
|
|
||||||
|
open( AR, "ar p $self->{'path'} snapinfo|" ) ||
|
||||||
|
Snap->error( int( $! ), "open(): $self->{'path'}: $!" );
|
||||||
|
sysopen( SNAPINFO, $snapinfo, O_RDWR|O_TRUNC|O_CREAT, 0644 ) ||
|
||||||
|
Snap->error( int( $! ), "sysopen(): $snapinfo: $!" );
|
||||||
|
|
||||||
|
while ( <AR> ) {
|
||||||
|
print SNAPINFO $_;
|
||||||
|
}
|
||||||
|
|
||||||
|
close( SNAPINFO ) || Snap->error( int( $! ),
|
||||||
|
"sysopen(): $snapinfo: $!" );
|
||||||
|
close( AR ) || Snap->error( int( $! ), "open(): $self->{'path'}: $!" );
|
||||||
|
|
||||||
|
if ( $oldpkg ) {
|
||||||
|
unlink( "$snapinfo.$oldpkg->{'version'}" ) ||
|
||||||
|
Snap->error( int( $! ), "unlink(): $snapinfo: $!" );
|
||||||
|
unlink( "$manifest.$oldpkg->{'version'}" ) ||
|
||||||
|
Snap->error( int( $! ), "unlink(): $manifest: $!" );
|
||||||
|
}
|
||||||
|
|
||||||
|
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 ( <SNAPINFO> ) {
|
||||||
|
if ( $_ =~ /^(\S+)\s*:\s*(.*)$/ ) {
|
||||||
|
$snapinfo->{$1} = $2;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
close( SNAPINFO ) ||
|
||||||
|
Snap->error( int( $! ), "open: $!" );
|
||||||
|
|
||||||
|
if ( $self->{'name'} eq $snapinfo->{'name'} &&
|
||||||
|
$self->{'version'} eq $snapinfo->{'version'} ) {
|
||||||
|
return( 1 );
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
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;
|
||||||
735
SRC/snap/Snap.pm
Normal file
735
SRC/snap/Snap.pm
Normal file
@@ -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 = <FILE>;
|
||||||
|
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 = <STDIN>;
|
||||||
|
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 ( <SKEL> ) {
|
||||||
|
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 ( <SNAPINFO> ) {
|
||||||
|
####################################
|
||||||
|
#
|
||||||
|
# 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 ( <MANIFEST> ) {
|
||||||
|
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 ( <FILE> ) {
|
||||||
|
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, "+</dev/tty" ) || Snap->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 <ed@membled.com> and Matt Johnson
|
||||||
|
# <mwj99@doc.ic.ac.uk> for recent releases; the original
|
||||||
|
# author is Kenneth J. Albanowski <kjahds@kjahds.com>.
|
||||||
|
# Thanks to Hack Kampbjørn and Slaven Rezic for patches
|
||||||
|
# and bug reports.
|
||||||
|
#
|
||||||
|
# Copyright (c) 1996, Kenneth J. Albanowski. All rights
|
||||||
|
# reserved. This program is free software; you can
|
||||||
|
# redistribute it and/or modify it under the same terms as
|
||||||
|
# Perl itself.
|
||||||
|
#
|
||||||
|
# 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;
|
||||||
358
SRC/snap/Sources.pm
Normal file
358
SRC/snap/Sources.pm
Normal file
@@ -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 => {
|
||||||
|
<PKGNAME> => [
|
||||||
|
Snap::Package->{'version'} => 1
|
||||||
|
Snap::Package->{'version'} => 2
|
||||||
|
]
|
||||||
|
}
|
||||||
|
installed => {
|
||||||
|
<PKGNAME> => 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/<SOURCENAME>
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
@@ -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:
|
|
||||||
@@ -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
|
|
||||||
2502
SRC/snap/snap
2502
SRC/snap/snap
File diff suppressed because it is too large
Load Diff
@@ -1,6 +0,0 @@
|
|||||||
[general]
|
|
||||||
snapdir = var/snap
|
|
||||||
pkgfile = packages.gz
|
|
||||||
|
|
||||||
[sources]
|
|
||||||
default = http://packages.snaplinux.org/
|
|
||||||
File diff suppressed because it is too large
Load Diff
@@ -1 +0,0 @@
|
|||||||
0.0alpha0
|
|
||||||
Reference in New Issue
Block a user