package SL;

use strict;
use warnings;

use SL::Commands;
use SL::Package;
use SL::Sources;

use Fcntl qw( :flock );
use IPC::Open3;
use IO::Socket::INET;
use Digest::SHA qw( sha1_hex sha256_hex );
use POSIX;

use parent 'Exporter';
our @EXPORT = qw(
	chkyes
	error
	genpkg
	httpget
	human
	infodir
	kernver
	ldconfig
	list
	listfiles
	pullarg
	virtfs
	readconf
	setup
	sha
	sha256
	target
	templates
	termsize
	trigger
	vercmp
	writelog
	$sl
	);

our $VERSION = '0.15';

############################################################
#
# Remove full path from process name
#
############################################################

$0 =~ s/.*\///;

############################################################
#
# Make sure we bring back the cursor if we're killed as
# well as umount any virtual filesystems that may have
# been mounted in $sl->{'target'}.
#
############################################################

$SIG{INT} = sub{
	if ( $SL::sl->{'target'} ) {
		virtfs( 'umount' );
		}

	unlock();

	print "\e[?25h\n";

	exit( 1 );
	};

our $sl = SL->new();

############################################################
#
# Export $sl->{'target'} to the environment for usher
#
# This may be removed, in fact it probably should be. The
# idea is that packages shouldn't have to care if they are
# installed in a target, but we may find that there are
# cases where it will have to know.
#
############################################################

$ENV{TARGET} = $sl->{'target'};

sub new {
	my $class = shift;
	my $self = {
		debug => SL->pullarg( {
			long => '--debug'
			} ),
		target => SL->pullarg( {
			short => '-t',
			long => '--target',
			arg2 => 1,
			keepargs => 1
			} ),
		version => $VERSION
		};

	############################################################
	#
	# Create target if not present
	#
	############################################################

	if ( $self->{'target'} && ! -d $self->{'target'} ) {
		print "Creating target directory '$self->{'target'}'\n";
		mkdirp( $self->{'target'} );
		}

	####################################################
	#
	# Here we determine what sl.conf we'll use. If
	# a target is used we will attempt to use the
	# sl.conf that is present in the target.
	#
	####################################################

	if ( $self->{'target'} && -f "$self->{'target'}/etc/sl.conf" ) {
		$self->{'conffile'} = "$self->{'target'}/etc/sl.conf";
		}
	elsif ( -f '/etc/sl.conf' ) {
		$self->{'conffile'} = '/etc/sl.conf';
		}
	else {
		SL->error( 1, "Missing sl.conf" );
		}

	if ( $self->{'target'} && -f "$self->{'target'}/etc/sl_version" ) {
		$self->{'verfile'} = "$self->{'target'}/etc/sl_version";
		}
	elsif ( -f '/etc/sl_version' ) {	
		$self->{'verfile'} = '/etc/sl_version';
		}
	else {
		SL->error( 1, "Missing sl_version" );
		}

	$self->{'sldir'} = "$self->{'target'}/var/lib/sl";
	$self->{'lockfile'} = "$self->{'target'}/.sl";
	$self->{'pkgdir'} = "$self->{'sldir'}/packages";
	$self->{'statdir'} = "$self->{'sldir'}/status";
	$self->{'srcdir'} = "$self->{'sldir'}/sources";

	open( my $fh, "<$self->{'verfile'}" ) ||
		SL->error( int( $1 ), "open(): $!" );
	$self->{'slver'} = <$fh>;
	close( $fh );
	chomp( $self->{'slver'} );

	return( bless( $self, $class ) );
	}

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 = SL->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";

			exit( 1 );
			}
		elsif ( lc( $yes ne 'y' ) ){
			print "Answer 'y' or 'n': ";

			undef( $yes );
			}
		}
	}

sub datetime{
	my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime( time );
	my @months = ( 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul',
		'Aug', 'Sep', 'Oct', 'Nov', 'Dec' );
	my $datetime = sprintf( '%s %2s %02d:%02d:%02d',
		$months[$mon], $mday, $hour, $min, $sec );

	return $datetime;
	}

### dirempty() #############################################
#
# A simple test for an empty directory. The default $empty
# is 1 (meaning there are no files in the directory), and
# $empty is set to 0 if any files are found.
#
############################################################

sub dirempty {
	my $class = shift;
	my $dir = shift;
	my $empty = 1;

	if ( ! -d $dir ) {
		SL->error( 1, "dirempty(): $dir: Invalid directory" );
		}

	opendir( my $dh, $dir ) || SL->error( int( $! ), "dirempty(): $!" );

	while ( readdir( $dh ) ) {
		if ( $_ ne '.' && $_ ne '..' ) {
			$empty = 0;

			last;
			}
		}

	return( $empty );
	}

### 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 = ();

	writelog( $errstr );
	print "\e[?25h";

	if ( $errstr ) {
		chomp( $errstr );

		print STDERR ( caller() )[1] .":\n  $errstr at line "
			. ( caller() )[2] . "\n";

		if ( $sl->{'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";
				}
			}

		if ( $status ) {
			print "\n";
			}
		}

	if ( $status ) {
		virtfs( 'umount' );

		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 || SL->error( 1, "genpkg(): pkgname missing" );
	my $skelfile = '/usr/share/sl/Makefile.skel';
	my $slreadme = "This is the directory where the manifest, slinfo,\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 ) ||
		SL->error( int( $! ), "mkdir: $pkgname: $!" );
	mkdir( "$pkgname/SL", 0755 ) || SL->error( int( $! ), $! );
	mkdir( "$pkgname/SRC", 0755 ) || SL->error( int( $! ), $! );
	mkdir( "$pkgname/SRC/patches", 0755 ) || SL->error( int( $! ), $! );

	open( SKEL, "<$skelfile" ) || SL->error( int( $! ), $! );
	open( MAKEFILE, ">$pkgname/Makefile" ) || SL->error( int( $! ), $! );

	while ( <SKEL> ) {
		print MAKEFILE $_;
		}

	close( MAKEFILE );
	close( SKEL );

	open( README, ">$pkgname/SL/README" ) || SL->error( int( $! ), $! );
	print README $slreadme;
	close( README );

	open( README, ">$pkgname/SRC/patches/README" )
		|| SL->error( int( $! ), $! );
	print README $patchreadme;
	close( README );
	}

sub grubmkconfig {
	my $cmd = 'grub-mkconfig -o /boot/grub/grub.cfg';
	my $stat;
	my $pid;

	if ( $pid = fork() ) {
		waitpid( $pid, 0 );
		$stat = $? >> 8;
		}
	else {
		if ( $> ) {
			my $fakeroot = '/usr/bin/fakeroot';
			my $fakechroot = '/usr/bin/fakechroot';

			if ( ! -x $fakeroot && ! -x $fakechroot ) {
				SL->error( 1, "$fakeroot and"
					. "$fakechroot not found" );
				}
			elsif ( ! -x $fakeroot ) {
				SL->error( 1, "$fakeroot not found" );
				}
			elsif ( ! -x $fakechroot ) {
				SL->error( 1, "$fakechroot not"
					. " found" );
				}

			$ENV{'PATH'} = "$ENV{'PATH'}:/sbin:/usr/sbin";
			$cmd = "$fakeroot $fakechroot /usr/sbin/chroot "
				. $SL::sl->{'target'}
				. " sh -c 'PATH=/bin:/sbin"
				. ':/usr/bin:/usr/sbin'
				. " $cmd'";
			}
		else {
			chroot( $SL::sl->{'target'} );
			chdir( '/' );
			}

		exec( $cmd ) || exit( 1 );
		}

	if ( $stat ) {
		SL->error( $stat, "Failed to run mkinitramfs" );
		}
	}

sub httpget {
	my $class = shift;
	my $url = shift;
	my $dest = shift;
	my $mode = shift;
	my $opts = 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'
		) || SL->error( int( $! ), "IO::Socket::Inet->new(): $!" );
	my $bytes = 0;
	my @wheel = qw( - \ | / );
	my $p = 0;

	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 ) ||
			SL->error( int( $! ), "sysopen(): $dest: $!" );

		if ( ! $opts->{'dialog'} ) {
			print "\e[?25l";
			}
		}

	while ( <$sock> ) {
		if ( $dest ) {
			$bytes += length( $_ );
			}

		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 );
				}

			if ( ! $opts->{'dialog'} ) {
				printf( "%-50.50s [%-20s] %s\r",
					"  $wheel[$p] Downloading $filename",
					'*' x int( $httpget{'pct'} / 5 ),
					"$httpget{'pct'}%" );

				if ( $p >= $#wheel ) {
					$p = 0;
					}
				else {
					$p++;
					}
				}
			elsif ( $bytes % 1024 == 0 ) {
				print "XXX\n" . int( $httpget{'pct'} )
					. "\n\nDownloading $filename\nXXX\n";
				}
			}
		}

	if ( $dest ) {
		if ( ! $opts->{'dialog'} ) {
			printf( "%-50.50s [%-20s] %s\e[?25h\n",
				"  * Downloaded $filename",
				'*' x 20,
				'100%' );
			}

		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 hwdb {
	my $udevadm = '/sbin/udevadm';
	my $cmd = "$udevadm hwdb --update";
	my $pid;
	my $stat;

	if ( ! -x $udevadm ) {
		return;
		}

	print "Executing $cmd\n";

	if ( $pid = fork() ) {
		waitpid( $pid, 0 );
		$stat = $? >> 8;
		}
	else {
		if ( $sl->{'target'} ) {
			exec( "$cmd -r $SL::sl->{'target'}" )
				|| exit( 1 );
			}
		else {
			exec( $cmd ) || exit( 1 );
			}
		}

	if ( $stat ) {
		SL->error( 0, "Failed executing $cmd" );
		}
	}

############################################################
#
# This just generates the dir directory file for info docs
#
############################################################

sub installinfo {
	my $infodir = "$SL::sl->{'target'}/usr/share/info";
	my $files = [];
	my $cnt = 0;

	print "Updating info directory entries\n";

	print "\e[?25l\r";

	open( my $fh, ">$infodir/dir" ) || SL->error( 0,
		"installinfo(): $infodir/dir: $!" );
	truncate( $fh, 0 );
	close( $fh );

	opendir( my $dh, $infodir ) || SL->error( 0, 'install-info failed' );

	while ( my $file = readdir( $dh ) ) {
		if ( -f "$infodir/$file" && $file =~ /.*info.*/ ) {
			push( @$files, "$infodir/$file" );
			}
		}

	closedir( $dh );
		
	foreach my $file ( sort{ $a cmp $b }( @$files ) ) {
		my $sel;
		my $stdout;
		my $stderr;
		my $stat;
		my $pid;

		$cnt++;

		print "\e[K$file\r";

		$sel = IO::Select->new();

		eval {
			$pid = open3( \*CHLDIN, \*CHLDOUT, \*CHLDERR,
				"install-info $file $infodir/dir" );
			} || SL->error( 0, 'install-info failed' );

		close( CHLDIN );

		$sel->add( *CHLDOUT, *CHLDERR );

		while ( my @fhs = $sel->can_read ) {
			foreach my $fh ( @fhs ) {
				if ( eof( $fh ) ) {
					$sel->remove( $fh );

					next;
					}

				if ( fileno( $fh ) == fileno( *CHLDOUT ) ) {
					$stdout .= <$fh>;
					}
				elsif ( fileno( $fh ) == fileno( *CHLDERR ) ) {
					$stderr .= <$fh>;
					}
				}
			}

		close( CHLDOUT );
		close( CHLDERR );

		waitpid( $pid, 0 );
		$stat = $? >> 8;

		if ( $? ) {
			SL->error( 0, "install-info: $file: $stderr" );
			}
		}

	print "\e[K$cnt info files indexed\e[?25h\n";
	}

sub ismountpoint {
	my $dir = shift;
	my $statA;
	my $statB;

	if ( ! -d $dir ) {
		return( 0 );
		}

	$statA = ( stat( $dir ) )[0];
	$statB = ( stat( "$dir/.." ) )[0];

	if ( $statA == $statB ) {
		return( 0 );
		}
	else {
		return( 1 );
		}
	}

sub ispkg {
	my $class = shift;
	my $file = shift;
	my $lines = 0;
	my $slinfo = 0;
	my $name = 0;
	my $version = 0;
	my $ispkg = 0;

	open( FILE, "<$file" ) || SL->error( 1, "open(): $file: $!" );

	while ( <FILE> ) {
		if ( substr( $_, 0, 7 ) eq 'slinfo/' ) {
			$slinfo++;
			}
		elsif ( substr( $_, 0, 5 ) eq 'name:' ) {
			$name++;
			}
		elsif ( substr( $_, 0, 8 ) eq 'version:' ) {
			$version++;
			}

		$lines++;

		if ( $lines >= 12 ) {
			last;
			}
		}

	close( FILE ) || SL->error( 1, "close(): $file: $!" );

	if ( $slinfo && $name && $version ) {
		return( 1 );
		}

	return( 0 );
	}

sub kernver {
	return( ( uname() )[2] );
	}

sub ldconfig {
	my $ldconfig = '/sbin/ldconfig';
	my $pid;
	my $stat;

	print "Executing ldconfig\n";

	if ( -f $ldconfig ) {
		if ( $pid = fork() ) {
			waitpid( $pid, 0 );
			$stat = $? >> 8;
			}
		else {
			if ( $sl->{'target'} ) {
				exec( "$ldconfig -r $SL::sl->{'target'}" )
					|| exit( 1 );
				}
			else {
				exec( $ldconfig ) || exit( 1 );
				}
			}

		if ( $stat ) {
			SL->error( 0, "Failed executing ldconfig" );
			}
		}
	}

sub lock {
	open( $sl->{'lockfh'}, '+>', $sl->{'lockfile'} ) ||
		SL->error( int( $! ), "open(): $sl->{'lockfile'}: $!" );
	flock( $sl->{'lockfh'}, LOCK_EX|LOCK_NB ) ||
		SL->error( int( $! ), "flock(): $sl->{'lockfile'}: $!" );
	}

sub mkdirp {
	( my $dir = shift ) =~ s/\/*$//;
	my $mode = shift;
	my $parent;

	if ( -d $dir ) {
		return;
		}

	if ( $dir =~ /.\/./ ) {
		( $parent = $dir ) =~ s/\/[^\/]+$//;

		if ( ! -d $parent ) {
			mkdirp( $parent, $mode );
			}
		}

	if ( $mode ) {
		mkdir( $dir, $mode ) ||
			SL->error( int( $! ), "mkdirp(): $dir: $!" );
		}
	else {
		mkdir( $dir ) || SL->error( int( $! ), "mkdirp(): $dir: $!" );
		}
	}

sub mkinitramfs {
	my $list = shift || return;
	my $cmds = [];
	my $stat;
	my $pid;

	if ( grep( $_ eq 'all', @$list ) ) {
		push( @$cmds, 'mkinitramfs all' );
		}
	else {
		foreach my $kernver ( @$list ) {
			push( @$cmds, "mkinitramfs $kernver" );
			}
		}

	foreach my $cmd ( @$cmds ) {
		if ( $pid = fork() ) {
			waitpid( $pid, 0 );
			$stat = $? >> 8;
			}
		else {
			if ( $> ) {
				my $fakeroot = '/usr/bin/fakeroot';
				my $fakechroot = '/usr/bin/fakechroot';

				if ( ! -x $fakeroot && ! -x $fakechroot ) {
					SL->error( 1, "$fakeroot and"
						. "$fakechroot not found" );
					}
				elsif ( ! -x $fakeroot ) {
					SL->error( 1, "$fakeroot not found" );
					}
				elsif ( ! -x $fakechroot ) {
					SL->error( 1, "$fakechroot not"
						. " found" );
					}

				$ENV{'PATH'} = "$ENV{'PATH'}:/sbin:/usr/sbin";
				$cmd = "$fakeroot $fakechroot /usr/sbin/chroot "
					. $SL::sl->{'target'}
					. " sh -c 'PATH=/bin:/sbin"
					. ':/usr/bin:/usr/sbin'
					. " $cmd'";
				}
			else {
				chroot( $SL::sl->{'target'} );
				chdir( '/' );
				}

			exec( $cmd ) || exit( 1 );
			}

		if ( $stat ) {
			SL->error( $stat, "Failed to run mkinitramfs" );
			}
		}
	}

### pullarg() ##############################################
#
# This takes a hash ref as an argument. The keys are as
# follows:
#
#   * short: The short arg (something like -t or -v)
#   * long: The long arg (--target or --verbose)
#   * arg2: Set to 1 (or other true value if the arg
#           requires a second argument
#   * keepargs: Set to 1 if the args should not be
#               removed from @ARGV
#
# pullarg will return either a 1 if the arg is present, or
# the second argument value if present. It will also remove
# the args from @ARGV.
#
############################################################

sub pullarg {
	my ( $class, $argopts ) = @_;
	my $returnval = '';

	foreach ( my $i = $#ARGV; $i >= 0; $i-- ) {
		if ( $ARGV[$i] =~ /^\-([a-z]{2,})/ ) {
			my @chars;

			foreach ( split( '', $1 ) ) {
				push( @chars, "-$_" );
				}

			splice( @ARGV, $i, 1, @chars);
			}
		}

	for ( my $i = $#ARGV; $i >= 0; $i-- ) {
		if ( $argopts->{'short'} && $ARGV[$i] eq $argopts->{'short'} ||
		$ARGV[$i] eq $argopts->{'long'} ) {
			if ( ! $argopts->{'arg2'} ) {
				$returnval = 1;

				if ( ! $argopts->{'keepargs'} ) {
					splice( @ARGV, $i, 1 );
					}
				}
			else {
				$returnval = $ARGV[$i+1] || SL->error( 2,
					"$argopts->{'long'}: Missing second"
					. " argument" );
				$returnval =~ s/\/$//;

				if ( ! $argopts->{'keepargs'} ) {
					splice( @ARGV, $i, 2 );
					}
				}
			}
		}

	return( $returnval );
	}

### readconf() #############################################
#
# reads INI style files and builds a data structure with the
# parsed values.
#
# The config file can 'include' additional directories.
# Files in these directories will be parsed and added to
# the the data structure.
#
# Files ending in .conf will be parsed into the root of the
# data structure while .spt (Snaplinux package template)
# files will be stored in 'templates'
#
############################################################

sub readconf {
	my $conffile = shift || $sl->{'conffile'};
	my $data = shift || {};
	my $section = '';
	my $line = 0;
	my $type;

	open( my $fh, "<", $conffile ) || SL->error( int( $! ),
		"open(): $conffile: $!\n" );

	while ( <$fh> ) {
		chomp( $_ );

		if ( $_ =~ /^\s*#/ || $_ =~ /^$/ ) {
			next;
			}
		elsif ( $_ =~ /\s*include\s+(.*)$/ ) {
			foreach my $dir ( split( ' ', $1 ) ) {
				opendir( my $dh, $dir ) ||
					SL->error( int( $! ),
					"opendir(): $dir: $!" );

				while ( my $file = readdir( $dh ) ) {
					if ( -f "$dir/$file" ) {

						readconf( "$dir/$file", $data );
						}
					}

				closedir( $dh ) || SL->error( int( $! ),
					"closedir(): $dir: $!" );
				}
			}
		elsif ( $_ =~ /\s*\[(\S+)\]\s*/ ) {
			$section = $1;

			if ( $section eq 'sources' && ! $data->{$section} ) {
				$data->{$section} = [];
				}
			}
		elsif ( $section eq 'sources' ) {
			push( @{$data->{$section}}, $_ );
			}
		elsif ( $_ =~ /(\S+)\s*=\s*(.*)$/ ) {
			$data->{$section}{$1} = $2;
			}
		}

	close( $fh );

	return( $data );
	}

### setup() ################################################
#
# This should be called if the files and directories
# needed by the Snaplinux package system need to be created.
# is found not to be present. This includes the directories
# in /var/lib/sl, /etc/sl.conf, and /etc/sl_version
#
# Returns 1 if sources were refreshed
#
############################################################

sub setup {
	if ( $sl->{'target'} && ! -e $sl->{'target'} ) {
		mkdir( $sl->{'target'}, 0755 ) ||
			SL->error( int( $! ), "mkdir: $!" );
		}
	if ( ! -e $sl->{'sldir'} ) {
		mkdirp( $sl->{'sldir'}, 0755 );
		}
	if ( ! -e $sl->{'pkgdir'} ) {
		mkdir( $sl->{'pkgdir'}, 0755 ) || SL->error( int( $! ),
			"mkdir(): $sl->{'pkgdir'}: $!" );
		}
	if ( ! -e $sl->{'statdir'} ) {
		mkdir( $sl->{'statdir'}, 0755 ) || SL->error( int( $! ),
			"mkdir(): $sl->{'statdir'}: $!" );
		}
	if ( ! -e $sl->{'srcdir'} ) {
		my $conf = readconf();
		my $sources = SL::Sources->new( $conf->{'sources'} );

		mkdir( $sl->{'srcdir'}, 0755 ) || SL->error( int( $! ),
			"mkdir(): $sl->{'srcdir'}: $!" );

		$sources->refresh();

		return( 1 );
		}
	}

### sha() ###############################################
#
# This sub returns a hex sha hash of a supplied file
#
############################################################

sub sha {
	my $class = shift;
	my $file = shift;
	my $digest = eval {
		Digest::SHA->new( 1 )->addfile( $file );
		} || SL->error( 1, "sha(): $file: $!\n" );

	return( $digest->hexdigest );
	}

### 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 );
		} || SL->error( 1, "sha256(): $file: $!\n" );

	return( $digest->hexdigest );
	}

sub templates {
	my $conf = shift;
	my $templatedir = $conf->{'slinstall'}{'templatedir'};
	my $unsorted = [];
	my $templates = {};

	if ( ! -d $templatedir ) {
		SL->error( 0, "templates(): $templatedir: no such file"
			. " or directory" );

		return();
		}

	opendir( my $dh, $templatedir ) ||
		SL->error( int( $! ), "templates(): $!" );

	while ( my $template = readdir( $dh ) ) {
		if ( $template eq '.' || $template eq '..' ) {
			next;
			}
		elsif ( ! -f "$templatedir/$template/packages" ) {
			SL->error( 0, "Template '$template' has"
				. " no packages" );

			next;
			}

		$templates->{$template}{'packages'} = [];

		open( my $fh, "$templatedir/$template/packages" ) ||
			SL->error( int( $! ), "templates(): $!" );

		while ( readline( $fh ) ) {
			chomp();

			if ( $_ =~ /^\s*#/ || $_ =~ /^$/ ) {
				next;
				}

			push( @{$templates->{$template}{'packages'}}, $_ );
			}

		close( $fh );
		}

	closedir( $dh );

	foreach ( sort { $a cmp $b }( @$unsorted ) ) {
		push( @$templates, $_ );
		}

	return( $templates );
	}

sub termsize {
        my $row = 24;
	my $col = 80;
	my $sel = IO::Select->new();
	my $stdout;
	my $stderr;
	my $stat;
	my $pid;

        eval {
                $pid = open3( \*CHLDIN, \*CHLDOUT, \*CHLDERR,
                        "stty size -F /dev/tty" );
        	} || return( { row => $row, col => $col } );

	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 ( $stdout && $stdout =~ /(\d+)\s+(\d+)/ ) {
		$row = $1;
		$col = $2;
		}

	return( { row => $row, col => $col } );
	}

sub trigger {
	if ( $sl->{'ldconfig'} || ref( $sl->{'mkinitramfs'} ) eq 'ARRAY' ||
	$sl->{'grubmkconfig'} || $sl->{'installinfo'} ) {
		print "Processing triggers\n";
		}

	if ( $sl->{'ldconfig'} ) {
		ldconfig();
		}
	if ( ref( $sl->{'mkinitramfs'} ) eq 'ARRAY' ) {
		mkinitramfs( $sl->{'mkinitramfs'} );
		}
	if ( $sl->{'grubmkconfig'} ) {
		grubmkconfig();
		}
	if ( $sl->{'installinfo'} ) {
		installinfo();
		}
	if ( $sl->{'hwdb'} ) {
		hwdb();
		}
	}

sub unlock {
	if ( $sl->{'lockfh'} && fileno( $sl->{'lockfh'} ) ) {
		while ( readline( $sl->{'lockfh'} ) ) {
			print "$_";
			}

		close( $sl->{'lockfh'} );
		}

	if ( -f $sl->{'lockfile'} ) {
		unlink( $sl->{'lockfile'} ) ||
			SL->error( int( $! ),
				"unlink(): $sl->{'lockfile'}: $!" );
		}
	}

### 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 Snaplinux 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;
	}

### virtfs() ###############################################
#
# Need to try and figure out a solution for user installs
#
# The user may not be able to mount the virt filesystems,
# so perhaps it could do some kind of linking instead?
#
# Also remember you might want to move chroot out of usher
# and into here! We could also try to do fakechroot as well
#
############################################################

sub virtfs {
	my $command = shift;
	my $virtfs = { 
		dev => {
			fs => 'devtmpfs',
			dev => 'none',
			dir => ( $sl->{'target'} || '' ) . '/dev'
			},
		proc => {
			fs => 'proc',
			dev => 'none',
			dir => ( $sl->{'target'} || '' ) . '/proc'
			},
		sys => {
			fs => 'sysfs',
			dev => 'none',
			dir => ( $sl->{'target'} || '' ) .'/sys'
			}
		};

	####################################################
	#
	# If not root or no target defined we return since
	# only root can mount, and the mount is only needed
	# if we're installing to a target.
	#
	####################################################

	if ( $> || ! $sl->{'target'} ) {
		return( 0 );
		}

	foreach my $fs ( sort( keys( %$virtfs ) ) ) {
		my $sel;
		my $cmd;
		my $stdout = '';
		my $stderr = '';
		my $stat = 0;
		my $pid;


		if ( ! -d $virtfs->{$fs}{'dir'} ) {
			next;
			}

		if ( $command eq 'mount' ) {
			if ( ismountpoint( $virtfs->{$fs}{'dir'} ) ) {
				next;
				}

			$cmd = "mount -t $virtfs->{$fs}{'fs'}"
				. " $virtfs->{$fs}{'dev'}"
				. " $virtfs->{$fs}{'dir'}";
			}
		elsif ( $command eq 'umount' ) {
			if ( ! ismountpoint( $virtfs->{$fs}{'dir'} ) ) {
				next;
				}

			$cmd = "umount $virtfs->{$fs}{'dir'}";
			}
		else {
			SL->error( 1, "virtfs(): $command:"
				. " not a valid command" );
			}

		eval {
			$pid = open3( \*CHLDIN, \*CHLDOUT, \*CHLDERR, $cmd );
			} || SL->error( int( $! ), "open3(): $cmd: $!" );

		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 ) ) {
					$stdout .= <$fh>;
					}
				elsif ( fileno( $fh ) == fileno( *CHLDERR ) ) {
					$stderr .= <$fh>;
					}
				}
			}

		close( CHLDOUT );
		close( CHLDERR );

		waitpid( $pid, 0 );
		$stat = $? >> 8;

		if ( $stat ) {
			return( 1 );
			}
		}

	foreach my $fs ( sort( keys( %$virtfs ) ) ) {
		if ( ! ismountpoint( $virtfs->{$fs}{'dir'} ) ) {
			return( 0 );
			}
		}

	return( 1 );
	}

sub writelog {
	my $msg = shift;
	my $logfile = "$sl->{'target'}/var/log/sl.log";

	open( my $fh, ">>$logfile" ) || return;

	print $fh datetime() . " sl[$$]: $msg\n";

	close( $fh );
	}

1;