File Coverage

blib/lib/Psh/OS/Unix.pm

Criterion	Covered	Total	%
statement	3	372	0.8
branch	0	186	0.0
condition	0	92	0.0
subroutine	1	46	2.1
pod	0	31	0.0
total	4	727	0.5

package Psh::OS::Unix;

use strict;
require POSIX;
require Psh::Locale;

$Psh::OS::PATH_SEPARATOR=':';
$Psh::OS::FILE_SEPARATOR='/';

$Psh::history_file = ".psh_history";

# Sets the title of the current window
sub set_window_title {
	my $title= shift;
	my $term= $ENV{TERM};
	if( $term=~ /^(rxvt.*)|(xterm.*)|(.*xterm)|(kterm)|(aixterm)|(dtterm)/) {
		print "\017\033]2;$title\007";
	}
}

#
# Returns the hostname of the machine psh is running on, preferrably
# the full version
#

sub get_hostname {
	require Sys::Hostname;
	return Sys::Hostname::hostname();
}

sub getcwd_psh {
    my $cwd;
    chomp($cwd = `pwd`);
    $cwd;
}

#
# Returns a list of well-known hosts (from /etc/hosts)
#
sub get_known_hosts {
	my $hosts_file = "/etc/hosts"; # TODO: shouldn't be hard-coded?
	my @result=();
	local *F_KNOWNHOST;
	if (open(F_KNOWNHOST,"< $hosts_file")) {
		my $hosts_text = join ('', );
		close(F_KNOWNHOST);
		push @result,Psh::Util::parse_hosts_file($hosts_text);
	}
	my $tmp= catfile(Psh::OS::get_home_dir(),
					 '.ssh','known_hosts');
	if (-r $tmp) {
		if (open(F_KNOWNHOST, "< $tmp")) {
			while () {
				chomp;
				next unless $_;
				if (/^([a-zA-Z].*?)\,/) {
					push @result, $1;
				}
			}
		}
	}
	if (!@result) {
		push @result,'localhost';
	}
	return @result;
}

#
# Returns a list of all users on the system, prepended with ~
#
{
	my @user_cache;
	sub get_all_users {
		unless (@user_cache) {
			CORE::setpwent;
			while (my ($name) = CORE::getpwent) {
				push(@user_cache,'~'.$name);
			}
			CORE::endpwent;
		}
		return @user_cache;
	}
}

#
# void display_pod(text)
#
sub display_pod {
	my $tmp= Psh::OS::tmpnam();
	my $text= shift;

	local *TMP;
	open( TMP,">$tmp");
	print TMP $text;
	close(TMP);

	eval {
		require Pod::Text;
		Pod::Text::pod2text($tmp,*STDOUT);
	};
	Psh::Util::print_debug_class('e',"Error: $@") if $@;
	print $text if $@;

	unlink($tmp);
}

sub get_home_dir {
	my $user = shift || $ENV{USER};
	return $ENV{HOME} if ((! $user) && (-d $ENV{HOME}));
	return (CORE::getpwnam($user))[7]||'';
}

sub get_rc_files {
	my @rc=();

	if (-r '/etc/pshrc') {
		push @rc, '/etc/pshrc';
	}
	my $home= Psh::OS::get_home_dir();
	if ($home) { push @rc, catfile($home,'.pshrc') };
	return @rc;
}

sub get_path_extension { return (''); }

#
# int inc_shlvl ()
#
# Increments $ENV{SHLVL}. Also checks for login shell status and does
# appropriate OS-specific tasks depending on it.
#
sub inc_shlvl {
	my @pwent = CORE::getpwuid($<);
	if ((! $ENV{SHLVL}) && ($pwent[8] eq $0)) { # would use $Psh::bin, but login shells are guaranteed full paths
		$Psh::login_shell = 1;
		$ENV{SHLVL} = 1;
	} else {
		$Psh::login_shell = 0;
		$ENV{SHLVL}++;
	}
}


###################################################################
# JOB CONTROL
###################################################################


#
# void _give_terminal_to (int PID)
#
# Make pid the foreground process of the terminal controlling STDIN.
#

{
	my $terminal_owner=0;

	sub _give_terminal_to
    {
		# If a fork of a psh fork tries to call this then exit
		# as it would probably mess up the shell
		# This hack is necessary as e.g.
		# alias ls=/bin/ls
		# ls &
		# call fork_process from within a fork

		return if $Psh::OS::Unix::forked_already;
		return if $terminal_owner==$_[0];
		$terminal_owner=$_[0];

		local $SIG{TSTP}  = 'IGNORE';
		local $SIG{TTIN}  = 'IGNORE';
		local $SIG{TTOU}  = 'IGNORE';
		local $SIG{CHLD}  = 'IGNORE';

		my ($pkg,$file,$line,$sub)= caller(1);
		my $status= POSIX::tcsetpgrp(fileno STDIN,$_[0]);
	}

	sub _get_terminal_owner
    {
		return $terminal_owner;
	}
}



#
# void _wait_for_system(int PID, [bool QUIET_EXIT], [bool NO_TERMINAL])
#
# Waits for a program to be stopped/ended, prints no message on normal
# termination if QUIET_EXIT is specified and true.
#
# If NO_TERMINAL is specified and true it won't try to transfer
# terminal ownership
#

sub _wait_for_system
{
	my($pid, $quiet) = @_;
	if (!defined($quiet)) { $quiet = 0; }

	my $psh_pgrp = CORE::getpgrp();

	my $pid_status = -1;

	my $job= Psh::Joblist::get_job($pid);

	return if ! $job;

	my $term_pid= $job->{pgrp_leader}||$pid;

	_give_terminal_to($term_pid);

	my $output='';
	my $status=1;
	my $returnpid;
	while (1) {
		if (!$job->{running}) { $job->continue; }
		{
			local $Psh::currently_active = $pid;
			$returnpid = CORE::waitpid($pid,POSIX::WUNTRACED());
			$pid_status = $?;
		}
		last if $returnpid<1;

		# Very ugly work around for the problem that
		# processes occasionally get SIGTTOUed without reason
		# We can do this here because we know the process has
		# to run and could not have been stopped by TTOU
		if ($returnpid== $pid &&
			POSIX::WIFSTOPPED($pid_status) &&
			Psh::OS::signal_name(POSIX::WSTOPSIG($pid_status)) eq 'TTOU') {
			$job->continue;
			next;
		}
		# Collect output here - we cannot print it while another
		# process might possibly be in the foreground;
		$output.=_handle_wait_status($returnpid, $pid_status, $quiet, 1);
		if ($returnpid == $pid) {
			$status=POSIX::WEXITSTATUS($pid_status);
			last;
		}
	}
	_give_terminal_to($psh_pgrp);
	Psh::Util::print_out($output) if length($output);
	return $status==0;
}

#
# void _handle_wait_status(int PID, int STATUS, bool QUIET_EXIT)
#
# Take the appropriate action given that waiting on PID returned
# STATUS. Normal termination is not reported if QUIET_EXIT is true.
#

sub _handle_wait_status {
	my ($pid, $pid_status, $quiet, $collect) = @_;
	# Have to obtain these before we potentially delete the job
	my $job= Psh::Joblist::get_job($pid);
	my $command = $job->{call};
	my $visindex= Psh::Joblist::get_job_number($pid);
	my $verb='';

	if (POSIX::WIFEXITED($pid_status)) {
		my $status= POSIX::WEXITSTATUS($pid_status);
		if ($status==0) {
			$verb= ucfirst(Psh::Locale::get_text('done')) unless $quiet;
		} else {
			$verb= ucfirst(Psh::Locale::get_text('error'));
		}
		Psh::Joblist::delete_job($pid);
	} elsif (POSIX::WIFSIGNALED($pid_status)) {
		my $tmp= Psh::Locale::get_text('terminated');
		$verb = "\u$tmp (" .
			Psh::OS::signal_description(POSIX::WTERMSIG($pid_status)) . ')';
		Psh::Joblist::delete_job($pid);
	} elsif (POSIX::WIFSTOPPED($pid_status)) {
		my $tmp= Psh::Locale::get_text('stopped');
		$verb = "\u$tmp (" .
			Psh::OS::signal_description(POSIX::WSTOPSIG($pid_status)) . ')';
		$job->{running}= 0;
	}
	if ($verb && $visindex>0) {
		my $line="[$visindex] $verb $pid $command\n";
		return $line if $collect;

		Psh::Util::print_out($line );
	}
	return '';
}


#
# void reap_children()
#
# Checks wether any children we spawned died
#

sub reap_children
{
	my $returnpid=0;
	while (($returnpid = CORE::waitpid(-1, POSIX::WNOHANG() |
									   POSIX::WUNTRACED())) > 0) {
		_handle_wait_status($returnpid, $?);
	}
}

sub execute_complex_command {
	my @array= @{shift()};
	my $fgflag= shift @array;
	my @return_val;
	my $success= 0;
	my $eval_thingie;
	my $pgrp_leader= 0;
	my $pid;
	my $string='';
	my @tmp;

	my ($read,$chainout,$chainin);

	for( my $i=0; $i<@array; $i++) {
		# ([ $strat, $how, \@options, \@words, $line]);
		my ($strategy, $how, $options, $words, $text, $opt)= @{$array[$i]};
		local $Psh::current_options= $opt;
		$text||='';

		my $line= join(' ',@$words);
		my $forcefork;
		($success, $eval_thingie,$words,$forcefork, @return_val)= $strategy->execute( \$line, $words, $how, $i>0);

		$forcefork||=$i<$#array;

		if( defined($eval_thingie)) {
  			if( $#array) {
  				($read,$chainout)= POSIX::pipe();
  			}
			foreach (@$options) {
				if ($_->[0]==Psh::Parser::T_REDIRECT() and
				    ($_->[1] eq '<&' or $_->[1] eq '>&')) {
					if ($_->[3] eq 'chainin') {
						$_->[3]= $chainin;
					} elsif ($_->[3] eq 'chainout') {
						$_->[3]= $chainout;
					}
				}
			}
			my $termflag=!($i==$#array);

			($pid,$success,@tmp)= _fork_process($eval_thingie,$words,
												$fgflag,$text,$options,
												$pgrp_leader,$termflag,
												$forcefork);

			if( !$i && !$pgrp_leader) {
				$pgrp_leader=$pid;
			}

  			if( $i<$#array && $#array) {
  				POSIX::close($chainout);
  				$chainin= $read;
  			}
			if( @return_val < 1 ||
				!defined($return_val[0])) {
				@return_val= @tmp;
			}
		}
		$string.='|' if $i>0;
		$string.=$text;
	}

	if( $pid) {
		my $job= Psh::Joblist::create_job($pid,$string);
		$job->{pgrp_leader}=$pgrp_leader;
		if( $fgflag) {
			$success=_wait_for_system($pid, 1);
		} else {
			my $visindex= Psh::Joblist::get_job_number($job->{pid});
			Psh::Util::print_out("[$visindex] Background $pgrp_leader $string\n");
		}
	}
	return ($success,\@return_val);
}

sub _setup_redirects {
	my $options= shift;
	my $save= shift;

	return [] if ref $options ne 'ARRAY';

	my @cache=();
	foreach my $option (@$options) {
		if( $option->[0] == Psh::Parser::T_REDIRECT()) {
			my $type= $option->[2];
			my $cachefileno;

			if ($option->[1] eq '<&') {
				POSIX::dup2($option->[3], $type);
			} elsif ($option->[1] eq '>&') {
				POSIX::dup2($option->[3], $type);
			} elsif ($option->[1] eq '<') {
				my $tmpfd= POSIX::open( $option->[3], &POSIX::O_RDONLY);
				POSIX::dup2($tmpfd, $type);
				POSIX::close($tmpfd);
			} elsif ($option->[1] eq '>') {
				my $tmpfd= POSIX::open( $option->[3], &POSIX::O_WRONLY |
										&POSIX::O_TRUNC | &POSIX::O_CREAT );
				POSIX::dup2($tmpfd, $type);
				POSIX::close($tmpfd);
			} elsif ($option->[1] eq '>>') {
				my $tmpfd= POSIX::open( $option->[3], &POSIX::O_WRONLY |
									   &POSIX::O_CREAT);
				POSIX::lseek($tmpfd,0, &POSIX::SEEK_END);
				POSIX::dup2($tmpfd, $type);
				POSIX::close($tmpfd);
			}
			if ($^F<$type) { # preserve filedescriptors higher than 2
				$^F=$type;
			}
		}
	}
	select(STDOUT);
	return \@cache;
}

sub _has_redirects {
	my $options= shift;
	return 0 if ref $options ne 'ARRAY';

	foreach my $option (@$options) {
		return 1 if( $option->[0] == Psh::Parser::T_REDIRECT());
	}
	return 0;
}

#
# void fork_process( code|program, words,
#                    int fgflag, text to display in jobs,
#                    redirection options,
#                    pid of pgroupleader, do not set terminal flag,
#                    force a fork?)
#

sub _fork_process {
    my( $code, $words, $fgflag, $string, $options,
		$pgrp_leader, $termflag, $forcefork) = @_;
	my($pid);

	# HACK - if it's foreground code AND perl code AND
	# there are no redirects
	# we do not fork, otherwise we'll never get
	# the result value, changed variables etc.
	if( $fgflag and !$forcefork and ref($code) eq 'CODE'
		and !_has_redirects($options)
	  ) {
		my @result= eval { &$code };
		Psh::Util::print_error($@) if $@ && $@ !~/^SECRET/;
		return (0,@result);
	}

	unless ($pid = fork) { #child
		unless (defined $pid) {
			Psh::Util::print_error_i18n('fork_failed');
			return (-1,0,undef);
		}

		$Psh::OS::Unix::forked_already=1;
		close(READ) if( $pgrp_leader);
		_setup_redirects($options,0);
		POSIX::setpgid(0,$pgrp_leader||$$);
		_give_terminal_to($pgrp_leader||$$) if $fgflag && !$termflag;
		remove_signal_handlers();

		if( ref($code) eq 'CODE') {
			my @tmp=&{$code};
			if (!@tmp or $tmp[0]) {
				CORE::exit(0);
			}
			CORE::exit(1);
		} else {
			{
				if( ! ref $options) {
					exec $code;
				} else {
					$code= shift @$words;
					exec { $code } @$words;
				}
			} # Avoid unreachable warning
			Psh::Util::print_error_i18n('exec_failed',$code);
			CORE::exit(-1);
		}
	}
	POSIX::setpgid($pid,$pgrp_leader||$pid);
	_give_terminal_to($pgrp_leader||$pid) if $fgflag && !$termflag;
	return ($pid,0,undef);
}

sub fork_process {
    my( $code, $fgflag, $string, $options) = @_;
	my ($pid,$sucess,@result)= _fork_process($code,undef,$fgflag,$string,$options);
	return @result if !$pid;
	my $job= Psh::Joblist::create_job($pid,$string);
	if( !$fgflag) {
		my $visindex= Psh::Joblist::get_job_number($job->{pid});
		Psh::Util::print_out("[$visindex] Background $pid $string\n");
	}
	_wait_for_system($pid, 1) if $fgflag;
	return undef;
}

#
# Returns true if the system has job_control abilities
#
sub has_job_control { return 1; }

#
# void restart_job(bool FOREGROUND, int JOB_INDEX)
#
sub restart_job
{
	my ($fg_flag, $job_to_start) = @_;

	my $job= Psh::Joblist::find_job($job_to_start);

	if(defined($job)) {
		my $pid = $job->{pid};
		my $command = $job->{call};

		if ($command) {
			my $verb;
			my $qRunning = $job->{running};

			if ($fg_flag) {
				$verb= ucfirst(Psh::Locale::get_text('foreground'));
			} elsif ($qRunning) {
				# bg request, and it's already running:
				return;
			} else {
				$verb= ucfirst(Psh::Locale::get_text('restart'));
			}
			my $visindex = Psh::Joblist::get_job_number($pid);
			Psh::Util::print_out("[$visindex] $verb $pid $command\n");

			if($fg_flag) {
				eval { _wait_for_system($pid, 0); };
				Psh::Util::print_debug_class('e',"Error: $@") if $@;
			} elsif( !$qRunning) {
				$job->continue;
			}
		}
	}
}

sub resume_job {
	my $job= shift;

	kill 'CONT', -$job->{pid};
	kill 'CONT', -$job->{pgrp_leader} if $job->{pgrp_leader};
}

# Simply doing backtick eval - mainly for Prompt evaluation
sub backtick {
	my $com=join ' ',@_;
	local $^F=50;
	my ($read,$write)= POSIX::pipe();

	unless(my $pid=fork) {
		POSIX::close($read);
		POSIX::dup2($write,fileno(*STDOUT));
		$^F=$write if ($write>$^F);
		my ($success)= Psh::evl($com);
		CORE::exit(!$success);
	}
	POSIX::close($write);
	my $result='';
	local(*READ);
	open(READ,"<&=$read");
	while() {
		$result.=$_;
	}
	close(READ);
	return $result;
}

###################################################################
# SIGNALS
###################################################################

# Setup special treatment of certain signals
# Having a value of 0 means to ignore the signal completely in
# the loops while a code ref installs a different default
# handler. Note that calling _ignore_handler is different than
# setting the signal action to ignore - if you set the signal
# action to ignore, the signal might be passed on to parent processes
# which could decide to handle them for us

my %special_handlers= (
					   'CHLD' => \&_ignore_handler,
					   'CLD'  => \&_ignore_handler,
					   'TTOU' => \&_ttou_handler,
					   'TTIN' => \&_ttou_handler,
					   'TERM' => \&Psh::OS::fb_exit_psh,
					   'HUP'  => \&Psh::OS::fb_exit_psh,
					   'SEGV' => 0,
					   'WINCH'=> 0,
					   'ZERO' => 0,
					   );

my @signals= grep { substr($_,0,1) ne '_' } keys %SIG;

#
# void remove_signal_handlers()
#
# This used to manually set INT, QUIT, CONT, STOP, TSTP, TTIN,
# TTOU, and CHLD.
#
# The new technique changes the settings of *all* signals. It is
# from Recipe 16.13 of The Perl Cookbook (Page 582). It should be
# compatible with Perl 5.004 and later.
#

sub remove_signal_handlers
{
	foreach my $sig (@signals) {
		next if exists($special_handlers{$sig}) &&
			! ref($special_handlers{$sig});
		$SIG{$sig} = 'DEFAULT';
	}
}

#
# void setup_signal_handlers
#
# This used to manually set INT, QUIT, CONT, STOP, TSTP, TTIN,
# TTOU, and CHLD.
#
# See comment for remove_signal_handlers() for more information.
#

sub setup_signal_handlers
{
	foreach my $sig (@signals) {
		if( exists($special_handlers{$sig})) {
			if( ref($special_handlers{$sig})) {
				$SIG{$sig}= $special_handlers{$sig};
			}
			next;
		}
		$SIG{$sig} = \&_signal_handler;
	}

	reinstall_resize_handler();
}


#
# Setup the SIGSEGV handler
#
sub setup_sigsegv_handler
{
	$SIG{SEGV} = \&_error_handler;
}

#
# Setup SIGINT handler for readline
#
sub setup_readline_handler
{
	$SIG{INT}= \&_readline_handler;
}

sub remove_readline_handler
{
	$SIG{INT}= \&_signal_handler;
}

sub reinstall_resize_handler
{
	Psh::OS::fb_reinstall_resize_handler();
	&_resize_handler('WINCH');
}


#
# readline_handler()
#
# Readline ^C handler.
#

sub _readline_handler
{
	my $sig= shift;
	setup_readline_handler();
	print "\n"; # Clean up the display
	die "SECRET $Psh::bin: Signal $sig\n"; # changed to SECRET... just in case
}

sub _ttou_handler
{
	_give_terminal_to($$);
}

#
# void _signal_handler( string SIGNAL )
#

sub _signal_handler
{
	my ($sig) = @_;

	if ($Psh::currently_active > 0) {
		Psh::Util::print_debug("Received signal SIG$sig, sending to $Psh::currently_active\n");

		kill $sig, -$Psh::currently_active;
	} elsif ($Psh::currently_active < 0) {
		Psh::Util::print_debug("Received signal SIG$sig, sending to Perl code\n");
		die "SECRET ${Psh::bin}: Signal $sig\n";
	} else {
		_give_terminal_to($$);
		Psh::Util::print_debug("Received signal SIG$sig, die-ing\n");
		die "SECRET ${Psh::bin}: Signal $sig\n" if $sig eq 'INT';
	}

	$SIG{$sig} = \&_signal_handler;
}


#
# ignore_handler()
#

sub _ignore_handler
{
}


sub _error_handler
{
	my ($sig) = @_;
	Psh::Util::print_error_i18n('unix_received_strange_sig',$sig);
	kill 'INT', $$; # HACK to stop a possible endless loop!
}

#
# _resize_handler()
#

sub _resize_handler
{
	my ($sig) = @_;

	Psh::OS::check_terminal_size();

	$SIG{$sig} = \&_resize_handler;
}

{
	my $debian=-1;
	sub _check_debian {
		if ($debian==-1) {
			if (-r '/etc/debian-version') {
				$debian=1;
			} else {
				$debian=0;
			}
		}
		return $debian;
	}
}

sub get_editor {
	my $file= shift;
	my $suggestion= shift;
	my $editor= $suggestion||$ENV{VISUAL}||$ENV{EDITOR};
	if (_check_debian()) {
		$editor ||='editor';
	} else {
		$editor ||='vi';
	}
	return $editor;
}

# File::Spec

sub canonpath {
    my ($path) = @_;
    $path =~ s|/+|/|g unless($^O eq 'cygwin');     # xx////xx  -> xx/xx
    $path =~ s|(/\.)+/|/|g;                        # xx/././xx -> xx/xx
    $path =~ s|^(\./)+||s unless $path eq "./";    # ./xx      -> xx
    $path =~ s|^/(\.\./)+|/|s;                     # /../../xx -> xx
    $path =~ s|/\Z(?!\n)|| unless $path eq "/";          # xx/       -> xx
    return $path;
}

sub catfile {
    my $file = pop @_;
    return $file unless @_;
    my $dir = catdir(@_);
    $dir .= "/" unless substr($dir,-1) eq "/";
    return $dir.$file;
}

sub catdir {
    my @args = @_;
    foreach (@args) {
        # append a slash to each argument unless it has one there
        $_ .= "/" if $_ eq '' || substr($_,-1) ne "/";
    }
    return canonpath(join('', @args));
}

sub file_name_is_absolute {
	my $file= shift;
	return scalar($file =~ m:^/:s);
}

sub rootdir {
	'/';
}

sub splitdir {
    my ($directories) = @_ ;

    if ( $directories !~ m|/\Z(?!\n)| ) {
        return split( m|/|, $directories );
    }
    else {
        my( @directories )= split( m|/|, "${directories}dummy" ) ;
        $directories[ $#directories ]= '' ;
        return @directories ;
    }
}

sub rel2abs {
    my ($path,$base ) = @_;

    # Clean up $path
    if ( ! file_name_is_absolute( $path ) ) {
        # Figure out the effective $base and clean it up.
        if ( !defined( $base ) || $base eq '' ) {
            $base = Psh::getcwd_psh() ;
        }
        elsif ( ! file_name_is_absolute( $base ) ) {
            $base = rel2abs( $base ) ;
        }
        else {
            $base = canonpath( $base ) ;
        }

        # Glom them together
        $path = catdir( $base, $path ) ;
    }

    return canonpath( $path ) ;
}

1;

__END__