LINUX.ORG.RU

помогите найти ошибки в следующем перловом коде


0

0

Я два бага уже нашёл но ещё не придумал что с ними делать :-(

sub _system (@) { my @command = @_; local %SIG; # Inherited in functions called from this block, # restored on return.

if ($doit) { if ($args{interactive}) {

# In this case, we allow interactive I/O, but we want it # logged. So, we run the subcommand under a pty.

my $ptym = new IO::Pty; die "Error assigning pty device: $!\n" unless $ptym; $ptym->autoflush(1);

my $pid = fork; die "Error creating new process: $!\n" unless (defined $pid);

if ($pid) { # parent

my $ptyfd = $ptym->fileno();

while(1) { my ($rin, $rout, $bytes, $buf);

vec ($rin, $ptyfd, 1) = 1; vec ($rin, STDIN_FILENO, 1) = 1;

my $nfound = select ($rout = $rin, undef, undef, undef);

last unless $nfound;

if (vec $rout, $ptyfd, 1) { $bytes = sysread $ptym, $buf, 8192; &report (6, "Read $bytes bytes from pty\n"); unless (defined $bytes) { print STDERR "$progname: read from \"$command[0]\": $!"; exit 1; } if ($bytes) { print $buf; } else { $ptym->close(); } }

if (vec $rout, STDIN_FILENO, 1) { # Technically, we probably shouldn't call # sysread() on STDIN, but we've made sure to # make it unbuffered, select() doesn't # interact well with read(), and we're not # reading from STDIN anywhere else.

$bytes = sysread STDIN, $buf, 8192; unless (defined $bytes) { print STDERR "$progname: read from STDIN: $!"; exit 1; } if ($bytes) { syswrite $ptym, $buf; } } }

} else { # child $Ximian::Run::subprocess_flag = 1; my $ptys = $ptym->slave(); close $ptym;

my $sid = POSIX::setsid() or die "setsid returns $!\n"; my $ttyfd = $ptys->fileno(); $ptys->autoflush(1);

close STDIN; close STDOUT; open(STDIN,"<&". $ttyfd) or die "Couldn't reopen tty for reading: $!\n"; # $ttyname ? open(STDOUT,">&". $ttyfd) or die "Couldn't reopen tty for writing: $!\n"; # $ttyname ? close STDERR; # put that here or we would never see those die's above... open(STDERR,">&". $ttyfd) or exit 1;

# BSDish systems need the TIOCSCTTY ioctl to allocate # a controlling terminal for a session; SysVish ones # do it automagically on the first open() of a tty # device.

ioctl $ptys, &TIOCSCTTY, (my $dummy = undef) or die "$progname: Error allocating controlling terminal: $!\n" if (defined &TIOCSCTTY);

exec @command; die "$progname: Error executing \"$command[0]\": $!\n"; }

} else { # !$args{interactive}

# If we're not interactive, we don't allow terminal input. # Handle this like a shell -- put the child into a # background process group, and if it gets stopped with # SIGTTIN, kill it.

local $SIG{INT} = local $SIG{TERM} = \&Ximian::Sighandler::pgrp_cleanup_exit_handler;

$Ximian::Sighandler::_system{pid} = fork; die "Error creating new process: $!\n" unless (defined $Ximian::Sighandler::_system{pid});

if ($Ximian::Sighandler::_system{pid}) { # parent

while(1) { my $kid = waitpid ($Ximian::Sighandler::_system{pid}, WUNTRACED); my $status = $?;

last if $kid < 0; last if (WIFEXITED($status) or WIFSIGNALED($status));

if (WIFSTOPPED($status)) { my $sig = WSTOPSIG($status); if ($sig == SIGTTIN or $sig == SIGTTOU) { print STDERR "Error: \"$command[0]\" attempted interactive I/O and interactive flag not set\n"; kill SIGKILL, $kid; waitpid ($Ximian::Sighandler::_system{pid}, 0); exit 1; } } }

# Clean up the whole pgrp if necessary. kill WTERMSIG($?), -$Ximian::Sighandler::_system{pid} if (WIFSIGNALED($?));

} else { # child

$Ximian::Run::subprocess_flag = 1;

# Redirect STDERR to STDOUT for better logging.

close STDERR; open (STDERR, ">&" . STDOUT_FILENO) or exit 1;

# Put myself into a new backgrounded process group, so # I get a SIGTTIN on an attempted read() from the tty.

# XXX This will still allow writes directly to # /dev/tty to bypass redirection-based logging # attempts. We can get around this by running the # whole mess under a pty, but that hasn't proven # necessary yet.

POSIX::setpgid(0,0);

exec @command; die "$progname: Error executing \"$command[0]\": $!\n"; } }

return $? >> 8;

} else { # !$doit &report (2, "$progname: WOULD run: \"", join (' ', @command), "\"\n"); return 0; } }

★★★★★

Re: помогите найти ошибки в следующем перловом коде

Тоже но с нормальным форматированием:

sub _system (@) {
    my @command = @_;
    local %SIG;  # Inherited in functions called from this block,
                 # restored on return.

    if ($doit) {
	if ($args{interactive}) {

	    # In this case, we allow interactive I/O, but we want it
	    # logged.  So, we run the subcommand under a pty.

	    my $ptym = new IO::Pty;
	    die "Error assigning pty device: $!\n"
		unless $ptym;
	    $ptym->autoflush(1);

	    my $pid = fork;
	    die "Error creating new process: $!\n"
		unless (defined $pid);

	    if ($pid) {
		# parent

		my $ptyfd = $ptym->fileno();

		while(1) {
		    my ($rin, $rout, $bytes, $buf);

		    vec ($rin, $ptyfd, 1) = 1;
		    vec ($rin, STDIN_FILENO, 1) = 1;

		    my $nfound = select ($rout = $rin, undef, undef, undef);

		    last unless $nfound;

		    if (vec $rout, $ptyfd, 1) {
			$bytes = sysread $ptym, $buf, 8192;
			&report (6, "Read $bytes bytes from pty\n");
			unless (defined $bytes) {
			    print STDERR "$progname: read from \"$command[0]\": $!";
			    exit 1;
			}
			if ($bytes) {
			    print $buf;
			} else {
			    $ptym->close();
			}
		    }

		    if (vec $rout, STDIN_FILENO, 1) {
			# Technically, we probably shouldn't call
			# sysread() on STDIN, but we've made sure to
			# make it unbuffered, select() doesn't
			# interact well with read(), and we're not
			# reading from STDIN anywhere else.

			$bytes = sysread STDIN, $buf, 8192;
			unless (defined $bytes) {
			    print STDERR "$progname: read from STDIN: $!";
			    exit 1;
			}
			if ($bytes) {
			    syswrite $ptym, $buf;
			}
		    }
		}

	    } else {
		# child
		$Ximian::Run::subprocess_flag = 1;
		my $ptys = $ptym->slave();
		close $ptym;

		my $sid = POSIX::setsid() or die "setsid returns $!\n";
		my $ttyfd = $ptys->fileno();
		$ptys->autoflush(1);

		close STDIN;
		close STDOUT;
		open(STDIN,"<&". $ttyfd)
		    or die "Couldn't reopen tty for reading: $!\n"; # $ttyname ?
		open(STDOUT,">&". $ttyfd)
		    or die "Couldn't reopen tty for writing: $!\n"; # $ttyname ?
		close STDERR; # put that here or we would never see those die's above...
		open(STDERR,">&". $ttyfd) or exit 1;

		# BSDish systems need the TIOCSCTTY ioctl to allocate
		# a controlling terminal for a session; SysVish ones
		# do it automagically on the first open() of a tty
		# device.

		ioctl $ptys, &TIOCSCTTY, (my $dummy = undef)
		    or die "$progname: Error allocating controlling terminal: $!\n"
			if (defined &TIOCSCTTY);

		exec @command;
		die "$progname: Error executing \"$command[0]\": $!\n";
	    }

	} else {           # !$args{interactive}

	    # If we're not interactive, we don't allow terminal input.
	    # Handle this like a shell -- put the child into a
	    # background process group, and if it gets stopped with
	    # SIGTTIN, kill it.

	    local $SIG{INT} = local $SIG{TERM} = \&Ximian::Sighandler::pgrp_cleanup_exit_handler;

	    $Ximian::Sighandler::_system{pid} = fork;
	    die "Error creating new process: $!\n"
		unless (defined $Ximian::Sighandler::_system{pid});

	    if ($Ximian::Sighandler::_system{pid}) {
		# parent

		while(1) {
		    my $kid = waitpid ($Ximian::Sighandler::_system{pid}, WUNTRACED);
		    my $status = $?;

		    last if $kid < 0;
		    last if (WIFEXITED($status) or WIFSIGNALED($status));

		    if (WIFSTOPPED($status)) {
			my $sig = WSTOPSIG($status);
			if ($sig == SIGTTIN or $sig == SIGTTOU) {
			    print STDERR
				"Error: \"$command[0]\" attempted interactive I/O and interactive flag not set\n";
			    kill SIGKILL, $kid;
			    waitpid ($Ximian::Sighandler::_system{pid}, 0);
			    exit 1;
			}
		    }
		}

		# Clean up the whole pgrp if necessary.
		kill WTERMSIG($?), -$Ximian::Sighandler::_system{pid}
		    if (WIFSIGNALED($?));

	    } else {
		# child

		$Ximian::Run::subprocess_flag = 1;

		# Redirect STDERR to STDOUT for better logging.

		close STDERR;
		open (STDERR, ">&" . STDOUT_FILENO)
		    or exit 1;

		# Put myself into a new backgrounded process group, so
		# I get a SIGTTIN on an attempted read() from the tty.

		# XXX This will still allow writes directly to
		# /dev/tty to bypass redirection-based logging
		# attempts.  We can get around this by running the
		# whole mess under a pty, but that hasn't proven
		# necessary yet.

		POSIX::setpgid(0,0);

		exec @command;
		die "$progname: Error executing \"$command[0]\": $!\n";
	    }
	}

	return $? >> 8;

    } else {     # !$doit
	&report (2, "$progname: WOULD run: \"", join (' ', @command), "\"\n");
	return 0;
    }
}

cvv ★★★★★ ()
Вы не можете добавлять комментарии в эту тему. Тема перемещена в архив.