Attachment #2418 for ticket #2134

View | Details | Raw Unified | Return to ticket 2134 | Differences between
Collapse All | Expand All




#! /usr/bin/perl -w
###############################################################################
#
# qalter - PBS wrapper for changing job status using scontrol
#
###############################################################################

use strict;
use FindBin;
use Getopt::Long 2.24 qw(:config no_ignore_case);
use lib "${FindBin::Bin}/../lib/perl";
use autouse 'Pod::Usage' => qw(pod2usage);
use Slurm ':all';
use Slurmdb ':all'; # needed for getting the correct cluster dims
use Switch;

# ------------------------------------------------------------------
# This makes the assumption job_id will always be the last argument
# -------------------------------------------------------------------
my $job_id = $ARGV[$#ARGV];
my (
	$err,
	$new_name,
	$output,
	$rerun,
	$resp,
	$slurm,
	$man,
	$help
);

# Remove this
my $scontrol = "/usr/slurm/bin/scontrol";

# ------------------------------
# Parse Command Line Arguments
# ------------------------------
GetOptions(
	'N=s'    => \$new_name,
	'r=s'    => \$rerun,
	'o=s'    => \$output,
	'help|?' => \$help,
	'man'    => \$man
	)
	or pod2usage(2);

pod2usage(0) if $help;

if ($man)
{
	if ($< == 0)    # Cannot invoke perldoc as root
	{
		my $id = eval { getpwnam("nobody") };
		$id = eval { getpwnam("nouser") } unless defined $id;
		$id = -2			  unless defined $id;
		$<  = $id;
	}
	$> = $<;			# Disengage setuid
	$ENV{PATH} = "/bin:/usr/bin";	# Untaint PATH
	delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
	if ($0 =~ /^([-\/\w\.]+)$/) {
		$0 = $1;		# Untaint $0
	} else {
		die "Illegal characters were found in \$0 ($0)\n";
	}
	pod2usage(-exitstatus => 0, -verbose => 2);
}

# ----------------------
# Check input arguments
# ----------------------
if (@ARGV < 1) {
	pod2usage(-message=>"Missing Job ID", -verbose=>0); 
} else {
	$slurm = Slurm::new();
	$resp = $slurm->get_end_time($job_id);
	if (not defined($resp)) {
		pod2usage(-message=>"Job id $job_id not valid!", -verbose=>0); 
	}
	if ((not defined($new_name)) and (not defined($rerun)) and (not defined($output))) {
		pod2usage(-message=>"no argument given!", -verbose=>0); 
	}
}

# --------------------------------------------
# Use Slurm's Perl API to change name of a job 
# --------------------------------------------
if ($new_name) {
	my %update = ();

	$update{job_id}  = $job_id;
	$update{name}    = $new_name;
	if (Slurm->update_job(\%update)) {
		$err = Slurm->get_errno();
		$resp = Slurm->strerror($err);
		pod2usage(-message=>"Job id $job_id name change error: $resp", -verbose=>0);
		exit(1);
	}
}

# ---------------------------------------------------
# Use Slurm's Perl API to change the requeue job flag
# ---------------------------------------------------
if ($rerun) {
	my %update = ();

	$update{job_id}  = $job_id;
	if (($rerun eq "n") || ($rerun eq "N")) {
		$update{requeue} = 0;
	} else {
		$update{requeue} = 1;
	}
	if (Slurm->update_job(\%update)) {
		$err = Slurm->get_errno();
		$resp = Slurm->strerror($err);
		pod2usage(-message=>"Job id $job_id requeue error: $resp", -verbose=>0);
		exit(1);
	}
}

# ------------------------------------------------------------
# Use Slurm's Perl API to change Comment string
# Comment is used to relocate an output log file
# ------------------------------------------------------------
if ($output) {
	# Example:
	# $comment="on:16337,stdout=/gpfsm/dhome/lgerner/tmp/slurm-16338.out,stdout=~lgerner/tmp/new16338.out";
	#
	my $comment;
	my %update = ();

	# ---------------------------------------
	# Get current comment string from job_id
	# ---------------------------------------
	my($job) = $slurm->load_job($job_id);
	$comment = $$job{'job_array'}[0]->{comment};

	# ----------------
	# Split at stdout
	# ----------------
	if ($comment) {
		my(@outlog) = split("stdout", $comment);

		# ---------------------------------
		# Only 1 stdout argument add a ','
		# ---------------------------------
		if ($#outlog < 2) {
			$outlog[1] .= ","
		}

		# ------------------------------------------------
		# Add new log file location to the comment string
		# ------------------------------------------------
		$outlog[2] = "=".$output;
		$comment = join("stdout", @outlog);
	} else {
		$comment = "stdout=$output";
	}

	# -------------------------------------------------
	# Make sure that "%j" is changed to current $job_id
	# -------------------------------------------------
	$comment =~ s/%j/$job_id/g ;

	# -----------------------------------------------------
	# Update comment and print usage if there is a response
	# -----------------------------------------------------
	$update{job_id}  = $job_id;
	$update{comment} = $comment;
	if (Slurm->update_job(\%update)) {
		$err = Slurm->get_errno();
		$resp = Slurm->strerror($err);
		pod2usage(-message=>"Job id $job_id comment change error: $resp", -verbose=>0);
		exit(1);
	}
}
exit(0);

##############################################################################

__END__

=head1 NAME

B<qalter> - alter a job name, the job rerun flag or the job output file name.

=head1 SYNOPSIS

qalter [-N Name] 
       [-r y|n]
       [-o output file]
       <job ID>

=head1 DESCRIPTION

The B<qalter> updates job name, job rerun flag or job output(stdout) log location. 

It is aimed to be feature-compatible with PBS' qsub.

=head1 OPTIONS

=over 4

=item B<-N>

Update job name in the queue

=item B<-r>

Alter a job rerunnable flag. "y" will allow a qrerun to be issued. "n" disable qrerun option.

=item B<-o>

Alter a job output log file name (stdout). 

The job log will be move/rename after the job has B<terminated>.

=item B<-?> | B<--help>

brief help message

=item B<-man> 

full documentation

=back

=head1 SEE ALSO

qrerun(1) qsub(1)
=cut


Return to ticket 2134

Lines 1-232 Link Here

(-)a/contribs/torque/qalter.pl (-232 / +232 lines)
1	#! /usr/bin/perl -w	1	#! /usr/bin/perl -w
2	###############################################################################	2	###############################################################################
3	#	3	#
4	# qalter - PBS wrapper for changing job status using scontrol	4	# qalter - PBS wrapper for changing job status using scontrol
5	#	5	#
6	###############################################################################	6	###############################################################################
7		7
8	use strict;	8	use strict;
9	use FindBin;	9	use FindBin;
10	use Getopt::Long 2.24 qw(:config no_ignore_case);	10	use Getopt::Long 2.24 qw(:config no_ignore_case);
11	use lib "${FindBin::Bin}/../lib/perl";	11	use lib "${FindBin::Bin}/../lib/perl";
12	use autouse 'Pod::Usage' => qw(pod2usage);	12	use autouse 'Pod::Usage' => qw(pod2usage);
13	use Slurm ':all';	13	use Slurm ':all';
14	use Slurmdb ':all'; # needed for getting the correct cluster dims	14	use Slurmdb ':all'; # needed for getting the correct cluster dims
15	use Switch;	15	use Switch;
16		16
17	# ------------------------------------------------------------------	17	# ------------------------------------------------------------------
18	# This makes the assumption job_id will always be the last argument	18	# This makes the assumption job_id will always be the last argument
19	# -------------------------------------------------------------------	19	# -------------------------------------------------------------------
20	my $job_id = $ARGV[$#ARGV];	20	my $job_id = $ARGV[$#ARGV];
21	my (	21	my (
22	$err,	22	$err,
23	$new_name,	23	$new_name,
24	$output,	24	$output,
25	$rerun,	25	$rerun,
26	$resp,	26	$resp,
27	$slurm,	27	$slurm,
28	$man,	28	$man,
29	$help	29	$help
30	);	30	);
31		31
32	# Remove this	32	# Remove this
33	my $scontrol = "/usr/slurm/bin/scontrol";	33	my $scontrol = "/usr/slurm/bin/scontrol";
34		34
35	# ------------------------------	35	# ------------------------------
36	# Parse Command Line Arguments	36	# Parse Command Line Arguments
37	# ------------------------------	37	# ------------------------------
38	GetOptions(	38	GetOptions(
39	'N=s' => \$new_name,	39	'N=s' => \$new_name,
40	'r=s' => \$rerun,	40	'r=s' => \$rerun,
41	'o=s' => \$output,	41	'o=s' => \$output,
42	'help\|?' => \$help,	42	'help\|?' => \$help,
43	'man' => \$man	43	'man' => \$man
44	)	44	)
45	or pod2usage(2);	45	or pod2usage(2);
46		46
47	pod2usage(0) if $help;	47	pod2usage(0) if $help;
48		48
49	if ($man)	49	if ($man)
50	{	50	{
51	if ($< == 0) # Cannot invoke perldoc as root	51	if ($< == 0) # Cannot invoke perldoc as root
52	{	52	{
53	my $id = eval { getpwnam("nobody") };	53	my $id = eval { getpwnam("nobody") };
54	$id = eval { getpwnam("nouser") } unless defined $id;	54	$id = eval { getpwnam("nouser") } unless defined $id;
55	$id = -2 unless defined $id;	55	$id = -2 unless defined $id;
56	$< = $id;	56	$< = $id;
57	}	57	}
58	$> = $<; # Disengage setuid	58	$> = $<; # Disengage setuid
59	$ENV{PATH} = "/bin:/usr/bin"; # Untaint PATH	59	$ENV{PATH} = "/bin:/usr/bin"; # Untaint PATH
60	delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};	60	delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
61	if ($0 =~ /^([-\/\w\.]+)$/) {	61	if ($0 =~ /^([-\/\w\.]+)$/) {
62	$0 = $1; # Untaint $0	62	$0 = $1; # Untaint $0
63	} else {	63	} else {
64	die "Illegal characters were found in \$0 ($0)\n";	64	die "Illegal characters were found in \$0 ($0)\n";
65	}	65	}
66	pod2usage(-exitstatus => 0, -verbose => 2);	66	pod2usage(-exitstatus => 0, -verbose => 2);
67	}	67	}
68		68
69	# ----------------------	69	# ----------------------
70	# Check input arguments	70	# Check input arguments
71	# ----------------------	71	# ----------------------
72	if (@ARGV < 1) {	72	if (@ARGV < 1) {
73	pod2usage(-message=>"Missing Job ID", -verbose=>0);	73	pod2usage(-message=>"Missing Job ID", -verbose=>0);
74	} else {	74	} else {
75	$slurm = Slurm::new();	75	$slurm = Slurm::new();
76	$resp = $slurm->get_end_time($job_id);	76	$resp = $slurm->get_end_time($job_id);
77	if (not defined($resp)) {	77	if (not defined($resp)) {
78	pod2usage(-message=>"Job id $job_id not valid!", -verbose=>0);	78	pod2usage(-message=>"Job id $job_id not valid!", -verbose=>0);
79	}	79	}
80	if ((not defined($new_name)) and (not defined($rerun)) and (not defined($output))) {	80	if ((not defined($new_name)) and (not defined($rerun)) and (not defined($output))) {
81	pod2usage(-message=>"no argument given!", -verbose=>0);	81	pod2usage(-message=>"no argument given!", -verbose=>0);
82	}	82	}
83	}	83	}
84		84
85	# --------------------------------------------	85	# --------------------------------------------
86	# Use Slurm's Perl API to change name of a job	86	# Use Slurm's Perl API to change name of a job
87	# --------------------------------------------	87	# --------------------------------------------
88	if ($new_name) {	88	if ($new_name) {
89	my %update = ();	89	my %update = ();
90		90
91	$update{job_id} = $job_id;	91	$update{job_id} = $job_id;
92	$update{name} = $new_name;	92	$update{name} = $new_name;
93	if (Slurm->update_job(\%update)) {	93	if (Slurm->update_job(\%update)) {
94	$err = Slurm->get_errno();	94	$err = Slurm->get_errno();
95	$resp = Slurm->strerror($err);	95	$resp = Slurm->strerror($err);
96	pod2usage(-message=>"Job id $job_id name change error: $resp", -verbose=>0);	96	pod2usage(-message=>"Job id $job_id name change error: $resp", -verbose=>0);
97	exit(1);	97	exit(1);
98	}	98	}
99	}	99	}
100		100
101	# ---------------------------------------------------	101	# ---------------------------------------------------
102	# Use Slurm's Perl API to change the requeue job flag	102	# Use Slurm's Perl API to change the requeue job flag
103	# ---------------------------------------------------	103	# ---------------------------------------------------
104	if ($rerun) {	104	if ($rerun) {
105	my %update = ();	105	my %update = ();
106		106
107	$update{job_id} = $job_id;	107	$update{job_id} = $job_id;
108	if (($rerun eq "n") \|\| ($rerun eq "N")) {	108	if (($rerun eq "n") \|\| ($rerun eq "N")) {
109	$update{requeue} = 0;	109	$update{requeue} = 0;
110	} else {	110	} else {
111	$update{requeue} = 1;	111	$update{requeue} = 1;
112	}	112	}
113	if (Slurm->update_job(\%update)) {	113	if (Slurm->update_job(\%update)) {
114	$err = Slurm->get_errno();	114	$err = Slurm->get_errno();
115	$resp = Slurm->strerror($err);	115	$resp = Slurm->strerror($err);
116	pod2usage(-message=>"Job id $job_id requeue error: $resp", -verbose=>0);	116	pod2usage(-message=>"Job id $job_id requeue error: $resp", -verbose=>0);
117	exit(1);	117	exit(1);
118	}	118	}
119	}	119	}
120		120
121	# ------------------------------------------------------------	121	# ------------------------------------------------------------
122	# Use Slurm's Perl API to change Comment string	122	# Use Slurm's Perl API to change Comment string
123	# Comment is used to relocate an output log file	123	# Comment is used to relocate an output log file
124	# ------------------------------------------------------------	124	# ------------------------------------------------------------
125	if ($output) {	125	if ($output) {
126	# Example:	126	# Example:
127	# $comment="on:16337,stdout=/gpfsm/dhome/lgerner/tmp/slurm-16338.out,stdout=~lgerner/tmp/new16338.out";	127	# $comment="on:16337,stdout=/gpfsm/dhome/lgerner/tmp/slurm-16338.out,stdout=~lgerner/tmp/new16338.out";
128	#	128	#
129	my $comment;	129	my $comment;
130	my %update = ();	130	my %update = ();
131		131
132	# ---------------------------------------	132	# ---------------------------------------
133	# Get current comment string from job_id	133	# Get current comment string from job_id
134	# ---------------------------------------	134	# ---------------------------------------
135	my($job) = $slurm->load_job($job_id);	135	my($job) = $slurm->load_job($job_id);
136	$comment = $$job{'job_array'}[0]->{comment};	136	$comment = $$job{'job_array'}[0]->{comment};
137		137
138	# ----------------	138	# ----------------
139	# Split at stdout	139	# Split at stdout
140	# ----------------	140	# ----------------
141	if ($comment) {	141	if ($comment) {
142	my(@outlog) = split("stdout", $comment);	142	my(@outlog) = split("stdout", $comment);
143		143
144	# ---------------------------------	144	# ---------------------------------
145	# Only 1 stdout argument add a ','	145	# Only 1 stdout argument add a ','
146	# ---------------------------------	146	# ---------------------------------
147	if ($#outlog < 2) {	147	if ($#outlog < 2) {
148	$outlog[1] .= ","	148	$outlog[1] .= ","
149	}	149	}
150		150
151	# ------------------------------------------------	151	# ------------------------------------------------
152	# Add new log file location to the comment string	152	# Add new log file location to the comment string
153	# ------------------------------------------------	153	# ------------------------------------------------
154	$outlog[2] = "=".$output;	154	$outlog[2] = "=".$output;
155	$comment = join("stdout", @outlog);	155	$comment = join("stdout", @outlog);
156	} else {	156	} else {
157	$comment = "stdout=$output";	157	$comment = "stdout=$output";
158	}	158	}
159		159
160	# -------------------------------------------------	160	# -------------------------------------------------
161	# Make sure that "%j" is changed to current $job_id	161	# Make sure that "%j" is changed to current $job_id
162	# -------------------------------------------------	162	# -------------------------------------------------
163	$comment =~ s/%j/$job_id/g ;	163	$comment =~ s/%j/$job_id/g ;
164		164
165	# -----------------------------------------------------	165	# -----------------------------------------------------
166	# Update comment and print usage if there is a response	166	# Update comment and print usage if there is a response
167	# -----------------------------------------------------	167	# -----------------------------------------------------
168	$update{job_id} = $job_id;	168	$update{job_id} = $job_id;
169	$update{comment} = $comment;	169	$update{comment} = $comment;
170	if (Slurm->update_job(\%update)) {	170	if (Slurm->update_job(\%update)) {
171	$err = Slurm->get_errno();	171	$err = Slurm->get_errno();
172	$resp = Slurm->strerror($err);	172	$resp = Slurm->strerror($err);
173	pod2usage(-message=>"Job id $job_id comment change error: $resp", -verbose=>0);	173	pod2usage(-message=>"Job id $job_id comment change error: $resp", -verbose=>0);
174	exit(1);	174	exit(1);
175	}	175	}
176	}	176	}
177	exit(0);	177	exit(0);
178		178
179	##############################################################################	179	##############################################################################
180		180
181	__END__	181	__END__
182		182
183	=head1 NAME	183	=head1 NAME
184		184
185	B<qalter> - alter a job name, the job rerun flag or the job output file name.	185	B<qalter> - alter a job name, the job rerun flag or the job output file name.
186		186
187	=head1 SYNOPSIS	187	=head1 SYNOPSIS
188		188
189	qalter [-N Name]	189	qalter [-N Name]
190	[-r y\|n]	190	[-r y\|n]
191	[-o output file]	191	[-o output file]
192	<job ID>	192	<job ID>
193		193
194	=head1 DESCRIPTION	194	=head1 DESCRIPTION
195		195
196	The B<qalter> updates job name, job rerun flag or job output(stdout) log location.	196	The B<qalter> updates job name, job rerun flag or job output(stdout) log location.
197		197
198	It is aimed to be feature-compatible with PBS' qsub.	198	It is aimed to be feature-compatible with PBS' qsub.
199		199
200	=head1 OPTIONS	200	=head1 OPTIONS
201		201
202	=over 4	202	=over 4
203		203
204	=item B<-N>	204	=item B<-N>
205		205
206	Update job name in the queue	206	Update job name in the queue
207		207
208	=item B<-r>	208	=item B<-r>
209		209
210	Alter a job rerunnable flag. "y" will allow a qrerun to be issued. "n" disable qrerun option.	210	Alter a job rerunnable flag. "y" will allow a qrerun to be issued. "n" disable qrerun option.
211		211
212	=item B<-o>	212	=item B<-o>
213		213
214	Alter a job output log file name (stdout).	214	Alter a job output log file name (stdout).
215		215
216	The job log will be move/rename after the job has B<terminated>.	216	The job log will be move/rename after the job has B<terminated>.
217		217
218	=item B<-?> \| B<--help>	218	=item B<-?> \| B<--help>
219		219
220	brief help message	220	brief help message
221		221
222	=item B<-man>	222	=item B<-man>
223		223
224	full documentation	224	full documentation
225		225
226	=back	226	=back
227		227
228	=head1 SEE ALSO	228	=head1 SEE ALSO
229		229
230	qrerun(1) qsub(1)	230	qrerun(1) qsub(1)
231	=cut	231	=cut
232		232