File: command.pl

package info (click to toggle)
tct 1.11-6.3
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 1,884 kB
  • ctags: 1,078
  • sloc: perl: 9,622; ansic: 4,909; makefile: 468; sh: 45
file content (198 lines) | stat: -rw-r--r-- 4,959 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
#++
# NAME
#	command.pl 3p
# SUMMARY
#	command plumbing
# SYNOPSIS
#	require 'command.pl';
#
#	$timeouts{$command} = $short_timeout;
#
#	execute_command(@command)
#
#	pipe_command($handle, @command, $mode)
#
#	redirect_command(@command, $file)
#
#	command_to_list(@command)
#
#	command_to_string(@command)
# DESCRIPTION
#	This module attempts to provide safe alternatives for running
#	commands with or without I/O redirected to or from files or pipes,
#	and for capturing the output from a command in a variable. In
#	particular, commands are not parsed by a shell.
#
#	Each command, and its method of I/O redirection, are logged to
#	the logging module.
#
#	Each command is logged to STDOUT if $verbose is set.
#
#	Each command is subjected to a time limit as specified in the
#	%timeouts hash. The default time limit is $short_timeout. For
#	convenience, the coroner.cf file provides initial values of
#	%timeouts, $short_timeout, $med_timeout and $long_timeout.
#
#	execute_command() executes the command without performing any
#	I/O redirection. The result is the command exit status.
#
#	pipe_command() executes the command with its input or output
#	redirected to or from the specified handle. The mode argument
#	is either "|-" in order to write to the command, or "-|" in
#	order to read from the command. The result is undef in case of
#	problems, otherwise the result is the handle argument.
#
#	redirect_command() executes the command with I/O redirection
#	under control by the $file argument. In order to redirect
#	input, specify "<filename"; in order to redirect output, specify
#	">filename" or ">>filename".  The result is -1 when fork()
#	was unable to create a process, the command exit status otherwise.
#	The command exit status is also available as $?.
#
#	command_to_list() executes the command and returns a list
#	of output lines. The result is undef in case of problems.
#	The command exit status is available as $?.
#
#	command_to_string() executes the command and returns a string
#	with the command output, including newlines.  The result is undef
#	in case of problems.  The command exit status is available as $?.
# LICENSE
#	This software is distributed under the IBM Public License.
# SEE ALSO
#	timeout(1) run command with time limit
# AUTHOR(S)
#	Wietse Venema
#	IBM T.J. Watson Research
#	P.O. Box 704, Yorktown Heights, NY 10598, USA
#--

require "logger.pl";

sub timed_exec
{
    my(@command) = @_;
    my($limit);

    $limit = $short_timeout 
	unless $limit = $timeouts{$command[0]};
    return (exec($TIMEOUT, $limit, @command));
}

# pipe_command($handle, @command, $mode) - run command, return handle

sub pipe_command
{
    my($handle, @command) = @_;
    my($mode) = pop(@command);
    my($pid);

    print "pipe_command: $handle @command $mode\n"
	if $verbose;

    die "pipe_command: invalid pipe mode: $mode\n"
	unless ($mode eq "-|" || $mode eq "|-");

    &log_item($mode eq "|-" ? "PIPETO_CMD" : "PIPEFROM_CMD", @command);

    return(undef)
	unless defined($pid = open($handle, $mode));

    if ($pid == 0) {
	&timed_exec(@command) || die "cannot exec $command[0]: $!\n";
	exit 1;
    } else {
	return($handle);
    }
}

# execute_command(@command) - run command, no I/O redirection

sub execute_command
{
    my(@command) = @_;
    my($pid);

    print "execute_command: @command\n"
	if $verbose;

    &log_item("EXECUTE_CMD", @command);

    if (($pid = fork()) == 0) {
	&timed_exec(@command) || die "cannot exec $command[0]: $!\n";
	exit 1;
    } elsif ($pid == -1) {
	return(-1);
    } else {
	waitpid($pid, 0);
	return($?);
    }
}

# redirect_command(@command, $file) - run command, redirected

sub redirect_command
{
    my(@command) = @_;
    my($file) = pop(@command);
    my($pid);

    print "redirect_command: @command $file\n"
	if $verbose;

    &log_item("REDIRECT_CMD", $file, @command);

    if (($pid = fork()) == 0) {
	if ($file =~ /^>/) {
	    open(STDOUT, $file) || die "cannot open $file: $!\n";
	} elsif ($file =~ /^</) {
	    open(STDIN, $file) || die "cannot open $file: $!\n";
	} else {
	    die "redirect_command: invalid I/O redirection: $file\n";
	}
	&timed_exec(@command) || die "cannot exec $command[0]: $!\n";
	exit 1;
    } elsif ($pid == -1) {
	return(-1);
    } else {
	waitpid($pid, 0);
	return($?);
    }
}

# command_to_list(@command) - run command, output to list

sub command_to_list
{
    my(@command) = @_;
    my(@output);
    my($pid);

    print "command_to_list: @command\n"
	if $verbose;

    &log_item("PIPEFROM_CMD", @command);

    return(undef)
	unless defined($pid = open(COMMAND_TO_LIST, "-|"));

    if ($pid == 0) {
	&timed_exec(@command) || die "cannot exec $command[0]: $!\n";
	exit 1;
    } else {
	@result = <COMMAND_TO_LIST>;
	close(COMMAND_TO_LIST);
	return(@result);
    }
}

# command_to_string(@command) - run command, output to string

sub command_to_string
{
    my(@command) = @_;

    return(join('', &command_to_list(@command)));
}

1;