#!/usr/bin/env perl
package WWW::Jenkins::Job;
# Copyright 2012 Netflix, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
use strict;
use warnings;
sub new {
my $class = shift;
my $self = bless { @_ }, $class;
for my $required ( qw(name jenkins url color) ) {
defined $self->{$required} || die "no $required parameter to WWW::Jenkins::Job->new()";
}
$self->{inQueue} ||= 0;
return $self;
}
sub copy {
my ( $self ) = shift;
return bless { %$self, @_ }, ref($self);
}
sub j {
return shift->{jenkins};
}
sub ua {
return shift->j->{ua};
}
sub name {
return shift->{"name"};
}
# turns the jenkins 'color' attribute into a color
# suitable for encoding in Term::ANSIColor.
# All aborted builds are marked as red
# ... these are the options we have to work with in ANSIColor
# attributes: reset, bold, dark, faint, underline, blink, reverse and concealed.
# foreground: black, red, green, yellow, blue, magenta, cyan and white.
# background: on_black, on_red, on_green, on_yellow, on_blue, on_magenta, on_cyan and on_white
sub color {
my ( $self ) = @_;
my $color = $self->{color};
$color =~ s/_anime$//;
$color = "green" if $self->j->{stoplight} && $color eq 'blue';
$color = 'faint' if $color eq 'disabled';
$color = 'red' if $color eq 'aborted';
$color = 'faint' if $color eq 'grey';
$color = 'faint' if $color eq 'notbuilt';
return $color;
}
sub number {
my ( $self ) = @_;
my $lb = $self->{lastBuild} ||= {};
return $lb->{number} if defined $lb->{number};
if( defined $lb->{url} ) {
my ( $num ) = ( $lb->{url} =~ m{/(\d+)/?$} );
return $lb->{number} = $num if defined $num;
}
$self->_load_lastBuild;
return $lb->{number};
}
sub started {
my ( $self ) = shift;
my $lb = $self->{lastBuild} ||= {};
return $lb->{timestamp} / 1000 if defined $lb->{timestamp};
$self->_load_lastBuild;
return $lb->{timestamp} / 1000;
}
sub duration {
my ( $self ) = shift;
my $lb = $self->{lastBuild} ||= {};
return $lb->{duration} / 1000 if defined $lb->{duration};
$self->_load_lastBuild;
return $lb->{duration} / 1000;
}
sub _load_lastBuild {
my ( $self ) = shift;
my $uri = "$self->{url}/api/json?depth=0&tree=lastBuild[url,duration,timestamp,number]";
my $res = $self->ua->get($uri);
my $data = WWW::Jenkins::parse_json($res->decoded_content());
return %{$self->{lastBuild}} = %{$data->{lastBuild}};
}
sub start {
my ( $self, $params ) = @_;
$self->j->login();
my @params;
if ( $self->{actions} ) {
for my $action ( @{$self->{actions}} ) {
if ( exists $action->{parameterDefinitions} ) {
for my $param ( @{$action->{parameterDefinitions}} ) {
if ( exists $params->{$param->{name}} ) {
push @params, { "name" => $param->{name}, "value" => $params->{$param->{name}} };
}
else {
push @params, { "name" => $param->{name}, "value" => $param->{defaultParameterValue}->{value} };
}
}
}
}
}
my $resp = $self->ua->post("$self->{url}/build", {delay => "0sec", json=> WWW::Jenkins::encode_json({"parameter" => \@params})});
if( $resp->is_error ) {
die "Failed to start $self->{name}, got error: " . $resp->status_line;
}
return 1;
}
sub stop {
my ( $self ) = @_;
die "job " . $self->name() . " has never been run"
unless $self->{lastBuild};
# dont stop something not running
return 1 unless $self->is_running();
$self->j->login();
my $resp = $self->ua->post("$self->{lastBuild}->{url}/stop", {});
if( $resp->is_error ) {
die "Failed to stop $self->{name}, got error: " . $resp->status_line;
}
return 1;
}
sub is_running {
my ( $self ) = @_;
return $self->{color} =~ /_anime/ ? 1 : 0;
}
sub is_queued {
my ( $self ) = @_;
return $self->{inQueue} ? 1 : 0;
}
sub was_aborted {
my ( $self ) = @_;
return $self->{color} eq 'aborted';
}
sub wipeout {
my ( $self ) = @_;
$self->j->login();
my $resp = $self->ua->post("$self->{url}/doWipeOutWorkspace", {});
if( $resp->is_error ) {
die "Failed to wipeout $self->{name}, got error: " . $resp->status_line;
}
return 1;
}
sub logCursor {
my ( $self ) = @_;
die "job " . $self->name() . " has never been run"
unless $self->{lastBuild};
my $res = undef;
return sub {
if( !$res ) {
$res = $self->ua->post(
"$self->{lastBuild}->{url}/logText/progressiveText", { start => 0 }
)
}
elsif( $res->header("X-More-Data") && $res->header("X-More-Data") eq 'true' ) {
$res = $self->ua->post(
"$self->{lastBuild}->{url}/logText/progressiveText", {
start => $res->header("X-Text-Size")
}
);
}
else {
# there was a previous response but X-More-Data not set, so we are done
return undef;
}
return $res->decoded_content || "";
}
}
sub disable {
my ( $self ) = @_;
$self->j->login();
my $resp = $self->ua->post("$self->{url}/disable", {});
if( $resp->is_error ) {
die "Failed to disable $self->{name}, got error: " . $resp->status_line;
}
return 1;
}
sub enable {
my ( $self ) = @_;
$self->j->login();
my $resp = $self->ua->post("$self->{url}/enable", {});
if( $resp->is_error ) {
die "Failed to enable $self->{name}, got error: " . $resp->status_line;
}
return 1;
}
sub config {
my ( $self, $content ) = @_;
$self->j->login();
my $url = "$self->{url}/config.xml";
my $resp;
if( $content ) {
my $req = HTTP::Request->new("POST", $url);
$req->content($content);
$resp = $self->ua->request($req);
}
else {
$resp = $self->ua->get($url, {});
}
if( $resp->is_error ) {
die "Failed get/set config.xml for $self->{name}, got error: " . $resp->status_line;
}
return $resp->decoded_content();
}
sub millis {
eval "use Time::HiRes";
if( $@ ) {
return time() * 1000;
}
else {
return Time::HiRes::time() * 1000
}
}
sub history {
my ( $self ) = @_;
my $res = $self->ua->get("$self->{url}/api/json?depth=11&tree=builds[result,url,number,building,timestamp,duration]");
my $data = WWW::Jenkins::parse_json($res->decoded_content());
my @out;
for my $build ( @{$data->{builds}} ) {
my $color;
if( $build->{building} ) {
$color = $self->{color};
$build->{duration} ||= $self->millis - $build->{timestamp}
}
else {
$color =
$build->{result} =~ /SUCCESS/ ? "blue" :
$build->{result} =~ /ABORTED/ ? "aborted" :
$build->{result} =~ /FAILURE/ ? "red" :
"grey" ;
}
warn("unknown result: $build->{result}\n") if $color eq 'grey';
push @out, $self->copy(
color => $color,
inQueue => 0,
lastBuild => $build,
);
}
return wantarray ? @out : \@out;
}
1;
package WWW::Jenkins::Node;
# Copyright 2012 Netflix, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
use strict;
use warnings;
sub new {
my $class = shift;
my $self = bless { @_ }, $class;
for my $required ( qw(name jenkins) ) {
defined $self->{$required} || die "no $required parameter to WWW::Jenkins::Node->new()";
}
$self->{url} ||= $self->j->{baseuri} . "/computer/$self->{name}";
$self->{color} = $self->{offline} ? "red" : "green";
my $busy = 0;
for my $exec ( @{$self->{executors}} ) {
$busy++ unless $exec->{idle};
}
$self->{offline} = $self->{offline};
$self->{temporarilyOffline} = $self->{temporarilyOffline};
$self->{busy} = $busy;
$self->{executors} = $self->{numExecutors};
return $self;
}
sub name {
return shift->{"name"};
}
sub is_running {
return shift->{busy};
}
sub offline {
return shift->{offline};
}
sub tempOffline {
return shift->{temporarilyOffline};
}
sub toggleOffline {
my $self = shift;
my $resp = $self->ua->post("$self->{url}/toggleOffline", {offlineMessage => ""});
if( $resp->is_error ) {
die "Failed to toggleOffline $self->{name}, got error: " . $resp->status_line;
}
return 1;
}
sub remove {
my $self = shift;
my $resp = $self->ua->post("$self->{url}/doDelete", {});
if( $resp->is_error ) {
die "Failed to nodeDelete $self->{name}, got error: " . $resp->status_line;
}
return 1;
}
*copy = *WWW::Jenkins::Job::copy;
*j = *WWW::Jenkins::Job::j;
*ua = *WWW::Jenkins::Job::ua;
*color = *WWW::Jenkins::Job::color;
if ( 0 ) { # fixed use only once nonsense
copy(); j(); ua(); color();
}
package WWW::Jenkins;
use strict;
use warnings;
# Copyright 2012 Netflix, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
use LWP::UserAgent qw();
use HTTP::Cookies qw();
use HTTP::Request qw();
use Carp qw(croak);
use URI;
our @CLEANUP;
sub new {
my $class = shift;
my $self = bless {
# defaults
stoplight => 0,
user => $ENV{USER},
@_
}, $class;
my $UA = $self->{verbose}
? "WWW::Jenkins::UserAgent"
: "LWP::UserAgent";
$self->{baseuri} || die "baseuri option required";
$self->{ua} ||= $UA->new(
cookie_jar => HTTP::Cookies->new(
file => "$ENV{HOME}/.$self->{user}-".URI->new($self->{baseuri})->host()."-cookies.txt",
autosave => 1,
),
ssl_opts => {
SSL_verify_callback => sub { 1 },
$self->{ssl_opts} ? %{$self->{ssl_opts}} : ()
}
);
return $self;
}
sub create {
my ($self, $job, $config) = @_;
if( ref($job) ) {
return $job->config($config);
}
$self->login();
my $req = HTTP::Request->new("POST", "$self->{baseuri}/createItem?name=$job");
$req->header("Content-Type" => "application/xml");
$req->content($config);
my $resp = $self->{ua}->request($req);
if( $resp->is_error ) {
die "Failed to create new job $job, got error: " . $resp->as_string;
}
}
sub search {
my ($self, $filter) = @_;
my $uri = "$self->{baseuri}/api/json?tree=jobs[name]";
my $res = $self->{ua}->get($uri);
my @out = ();
if( $res->is_success ) {
my $data = parse_json($res->decoded_content());
@out = grep { /$filter/ } map { $_->{name} } @{$data->{jobs}};
}
return wantarray ? @out : \@out;
}
sub jobs {
my ($self,@jobs) = @_;
my @out = ();
for my $job ( @jobs ) {
my $uri = "$self->{baseuri}/job/$job/api/json?depth=0&tree=name,inQueue,url,lastBuild[number,url],color,actions[parameterDefinitions[defaultParameterValue[value],name]]";
my $res = $self->{ua}->get($uri);
if( $res->is_success ) {
my $data = parse_json($res->decoded_content());
push @out, WWW::Jenkins::Job->new(%$data, jenkins => $self);
}
}
return wantarray ? @out : \@out;
}
sub nodes {
my ($self, $label) = @_;
$self->login();
my @out = ();
my $uri = "$self->{baseuri}/computer/(master)/config.xml";
my $res = $self->{ua}->get($uri);
if( $res->is_success ) {
my $xml = $res->decoded_content();
my $res = $self->{ua}->get("$self->{baseuri}/computer/api/json?depth=1&tree=computer[displayName,executors[idle],numExecutors,offline,temporarilyOffline]");
my $data = WWW::Jenkins::parse_json($res->decoded_content);
my %nodeData = map { $_->{displayName} => $_ } @{$data->{computer}};
#print "$xml\n";
my @slaves = ($xml =~ m{(.*?)}sg );
for my $slave (@slaves) {
my %names = ($slave =~ m{(\s+)(.*?)}sg );
my $smallest_indent = (sort keys %names)[0];
my $name = $names{$smallest_indent};
my ($labels) = ($slave =~ m{}sg );
if( $label && $labels =~ /$label/ || $name =~ /$label/ ) {
my @labels = sort split /\s+/, $labels;
if ( $name eq 'All' ) {
print "$slave\n";
use Data::Dumper;
print Dumper(\%names);
print "smallest: \"$smallest_indent\" => $names{$smallest_indent}\n";
exit;
}
#print "$name => $labels\n";
push @out, WWW::Jenkins::Node->new(jenkins => $self, name => $name, labels => \@labels, %{$nodeData{$name}})
}
}
#use Data::Dumper;
#warn Dumper(\@slaves);
#print $xml;
#exit -1;
}
return \@out;
# my $uri = "$self->{baseuri}/computer/api/json?depth=0&tree=computer[displayName]";
# my $res = $self->{ua}->get($uri);
# if( $res->is_success ) {
# my $data = parse_json($res->decoded_content());
# for my $node ( @{$data->{"computer"}} ) {
# }
# }
}
sub views {
my ($self,@views) = @_;
my @out = ();
for my $view ( @views ) {
# turns A/B into A/view/B which is needed
# in jenkins uri for subviews
my $viewPath = join("/view/", split '/', $view);
my $uri = "$self->{baseuri}/view/$viewPath/api/json?depth=1&tree=views[name,url],jobs[name,inQueue,url,lastBuild[number,url,timestamp,duration],color]";
my $res = $self->{ua}->get($uri);
my $data = parse_json($res->decoded_content());
# we dont know if the view has subviews or it it has jobs, so try for both
# and recurse if we find a subview
if( $data->{jobs} ) {
push @out, WWW::Jenkins::Job->new(%$_, jenkins => $self) for @{$data->{jobs}};
}
if( $data->{views} ) {
push @out, $self->views("$view/$_->{name}") for @{$data->{views}};
}
}
return wantarray ? @out : \@out;
}
sub queue {
my ( $self ) = @_;
my $uri = "$self->{baseuri}/queue/api/json?depth=0&tree=items[task[color,name,url],why,stuck]";
my $res = $self->{ua}->get($uri);
#print $res->decoded_content;
my $data = parse_json($res->decoded_content());
my %blocked;
my %stuck;
my @running;
my @quieted;
for my $item ( @{$data->{items}} ) {
my $job = WWW::Jenkins::Job->new(
%{$item->{task}},
inQueue => 1,
jenkins => $self
);
if( $item->{stuck} ) {
if( !$item->{why} ) {
warn "no reason given why $item->{task}->{name} is stuck\n";
next;
}
if( $item->{why} =~ /([^ ]+) (is|are) offline/ ) {
push @{$stuck{$1}}, $job;
}
else {
warn "don't understand why $item->{task}->{name} is stuck: $item->{why}\n";
}
}
else {
if( !$item->{why} ) {
warn "no reason given why $item->{task}->{name} is enqueued\n";
next;
}
if( $item->{why} =~ /Waiting for next available executor on (.*)/ ) {
push @{$blocked{$1}}, $job;
}
elsif( $item->{why} =~ /already in progress/ ) {
push @running, $job;
}
elsif( $item->{why} =~ /quiet period/ ) {
push @quieted, $job;
}
else {
warn "don't understand why $item->{task}->{name} is enqueued: $item->{why}\n";
}
}
}
return {
blocked => \%blocked,
stuck => \%stuck,
running => \@running,
quieted => \@quieted,
};
}
sub login {
my ( $self ) = @_;
return if $self->{logged_in};
# FIXME there has to be a better way to tell if we
# are already logged in ...
# just load the page with the smallest content that I could find
# and check for a "log in" string to indicate the user is not
# logged in already
my $res = $self->{ua}->get("$self->{baseuri}/user/$self->{user}/?");
if ( $res->decoded_content =~ />log in ) {
$res = $self->{ua}->post(
"$self->{baseuri}/j_acegi_security_check", {
j_username => $self->{user},
j_password => $self->password(),
}
);
$self->{ua}->get("$self->{baseuri}/user/$self->{user}/?");
$self->{ua}->cookie_jar->scan(
sub {
my @args = @_;
# dont discard cookies, so we dont get prompted for a password everytime
$args[9] = 0;
$self->{ua}->cookie_jar->set_cookie(@args);
}
);
}
$self->{logged_in}++;
return;
}
sub stdio {
my $self = shift;
my ($in, $out);
if( !-t STDIN || !-t STDOUT ) {
# stdio missing, so try to use tty directly
my $tty = "/dev/tty" if -e "/dev/tty";
if( !$tty ) {
my ($ttyBin) = grep { -x $_ } qw(/bin/tty /usr/bin/tty);
if ( $ttyBin ) {
$tty = qx{$ttyBin};
chomp($tty);
}
}
if( !$tty ) {
die "Could not determine TTY to read password from, aborting";
}
open $in, "<$tty" or die "Failed to open tty $tty for input: $!";
open $out, ">$tty" or die "Failed to open tty $tty for output: $!";
}
else {
# using stdio
$in = \*STDIN;
$out = \*STDOUT;
}
return ($in, $out);
}
sub password {
my ( $self ) = @_;
if ( ref($self) && defined $self->{password} ) {
if ( ref($self->{password}) eq 'CODE' ) {
return $self->{password}->($self);
}
return $self->{password};
}
my ($in, $out) = $self->stdio;
my $old = select $out;
eval "use Term::ReadKey";
if( $@ ) {
# no readkey, so try for stty to turn off echoing
my ($sttyBin) = grep { -x $_ } qw(/bin/stty /usr/bin/stty);
if( $sttyBin ) {
push @CLEANUP, sub {
system($sttyBin, "echo");
};
system($sttyBin, "-echo");
}
else {
die "Unable to disable echo on your tty while reading password, aborting";
}
}
else {
# use readkey to turn off echoing
push @CLEANUP, sub {
Term::ReadKey::ReadMode("restore", $out);
};
Term::ReadKey::ReadMode("noecho", $out);
}
my $user = ref($self) eq 'HASH' ? $self->{user} : $ENV{USER};
print $out "Jenkins Password [$user]: ";
my $pass = <$in>;
$CLEANUP[-1]->();
print $out "\n";
chomp($pass);
select $old;
return $pass;
}
{
my $parser;
my $encoder;
sub init_json {
# no parser, so find one
eval "use JSON::XS qw()";
unless( $@ ) {
$parser = JSON::XS->can("decode_json") || JSON::XS->can("from_json");
$encoder = JSON::XS->can("encode_json") || JSON::XS->can("to_json");
return;
}
eval "use JSON qw()";
unless ( $@ ) {
$parser = JSON->can("decode_json") || JSON->can("jsonToObj");
$encoder = JSON->can("encode_json") || JSON->can("objToJson");
return;
}
eval "use JSON::DWIW qw()";
unless ( $@ ) {
$parser = JSON::DWIW->can("from_json");
$encoder = JSON::DWIW->can("to_json");
return;
}
eval "use JSON::Syck qw()";
unless ( $@ ) {
$parser = JSON::Syck->can("Load");
$encoder = JSON::Syck->can("Dump");
return;
}
die "No valid JSON parser found, try JSON::XS, JSON, JSON::DWIW, or JSON::Syck";
}
sub parse_json {
$parser or init_json();
my $output = eval {
$parser->(@_)
};
if( $@ ) {
croak "Failed to parse JSON:\n", @_;
}
return $output;
}
sub encode_json {
$encoder or init_json();
my $output = eval {
$encoder->(@_)
};
if ( $@ ) {
croak "Failed to generate JSON:\n", @_;
}
return $output;
}
}
END {
for my $cleaner ( @CLEANUP ) {
$cleaner->();
}
}
# silly class to make debugging easier
package WWW::Jenkins::UserAgent;
use base qw(LWP::UserAgent);
sub request {
my $self = shift;
my $req = shift;
my $resp = $self->SUPER::request($req, @_);
print "======================================>\n";
print $req->as_string;
print "<======================================\n";
print $resp->as_string;
return $resp;
}
1;
package main;
#!/usr/bin/env perl
# Copyright 2012 Netflix, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
use strict;
use warnings;
use YAML::Syck;
use Term::ANSIColor;
use Getopt::Long;
use File::Basename qw();
$|++;
sub usage {
my $err = shift || 0;
my $io = $err ? *STDERR : *STDOUT;
print $io ("-")x76,"\n" if $err;
print $io <]
Global Options:
--all: search jenkins for job names, ignore jobs in ~/.jenkins
--baseuri=: base uri to jenkins server [http://jenkins]
--stoplight: make blue builds green [off]
--job=: specify a job name, can be repeated
--view=: speficy a list of jobs by view
--yes: always answer yes to any question
--password: prompt for password once
Commands:
ls|list []: show status of builds, optionally filter on pattern
login: login to all configured jenkins masters
start : start job
stop : stop job
tail : tail the most recent build log for a job
disable : disable job
enable : enable a job
wipeout : delete current build workspace for a job
q|queue: shows pending build queue grouped by build-slaves
hist|history: list history of builds for a job
conf|config: dump config.xml for a job
create : create/update new jenkins job from config.xml
nodes
nodesToggle
nodesDelete
* Note can be any regular expression to match jobs in your
default job list/view
EOM
exit $err;
}
my @actions;
my @commands = qw(ls list login start stop tail disable enable wipeout q queue hist history conf config create nodes nodesToggle nodesDelete);
my %options;
$options{$_} = sub { push @actions, shift } for @commands;
my %opts = (
master => "*"
);
GetOptions(
"help" => sub { usage(0) },
"all" => \$opts{all},
"baseuri=s" => \$opts{baseuri},
"stoplight" => \$opts{stoplight},
"job=s@" => \$opts{jobs},
"view=s@" => \$opts{views},
"yes" => \$opts{yes},
"color!" => \$opts{color},
"verbose" => \$opts{verbose},
"user" => \$opts{user},
"stuck" => \$opts{stuck},
"param|p=s@" => \$opts{params},
"password" => \$opts{password},
"yes" => \$opts{yes},
"master=s" => \$opts{master},
"online" => \$opts{online},
"offline" => \$opts{offline},
"busy" => \$opts{busy},
"idle" => \$opts{idle},
%options,
) || usage(1);
for my $key ( keys %opts ) {
delete $opts{$key} unless defined $opts{$key}
}
my @jenkins = ();
if( $opts{password} ) {
$opts{password} = WWW::Jenkins->password();
}
for my $cfg ( glob("$ENV{HOME}/.jenkins*$opts{master}*" ) ) {
if( ! $opts{baseuri} && -f $cfg ) {
my $config = YAML::Syck::LoadFile($cfg);
$config->{baseuri} ||= "http://jenkins";
$config->{user} ||= $ENV{USER};
push @jenkins, WWW::Jenkins->new(%$config, %opts);
}
}
if( !@jenkins ) {
push @jenkins, WWW::Jenkins->new( baseuri => "http://jenkins", user => $ENV{USER}, %opts)
}
my @args;
for my $arg ( @ARGV ) {
if( grep { $arg eq $_ } @commands ) {
push @actions, $arg;
}
else {
push @args, $arg;
}
}
my $filter = shift @args || ".";
if( !@actions ) {
list(load("list"), @args);
}
else {
for my $action ( @actions ) {
no strict "refs";
my $func = *{"main::$action"};
$func->(load($action), \@args);
}
}
BEGIN {
# create function aliases
no warnings "once";
*ls = \&list;
*q = \&queue;
*hist = \&history;
*conf = \&config;
# these routines are all the same, just loop over all jobs
# and try to run the operation on each job.
for my $func (qw(start stop disable enable wipeout)) {
no strict 'refs';
*{"main::$func"} = sub {
my ( $jobs, $args ) = @_;
confirm_multiple($func, $jobs) if @$jobs > 1;
for my $job ( @$jobs ) {
eval {
if ( $func eq 'start') {
$job->$func( { map { split /=/, $_, 2 } @{$opts{params}} } )
}
else {
$job->$func()
}
};
printf "%s %s: %s\n", ucfirst($func), $job->name(), $@ ? "ERROR: $@" : "OK";
}
}
}
};
{
my $jobs;
my $nodes;
sub load {
my $action = shift;
return [] if $action eq 'q' || $action eq 'queue' || $action eq 'login';
if( $action =~ /^nodes/) {
return $nodes if $nodes;
my @nodes;
for my $jenkins ( @jenkins ) {
push @nodes, @{$jenkins->nodes($filter)};
}
return \@nodes;
}
else {
return $jobs if $jobs;
my @jobs;
for my $jenkins ( @jenkins ) {
my $jobNames = $opts{all} ? $jenkins->search($filter) : $jenkins->{jobs};
my %uniq;
push @jobs, grep { !$uniq{$_->name}++ } $jenkins->jobs(grep{ /$filter/ } @$jobNames);
push @jobs, grep { !$uniq{$_->name}++ } $jenkins->views(@{$jenkins->{views}});
}
if( $filter ) {
@jobs = grep { $_->name =~ /$filter/ } @jobs;
my @exact = grep { $_->name eq $filter } @jobs;
@jobs = @exact if @exact;
if( ! @jobs ) {
# perhaps the name is not in the config file
# but is a job on the jenkins master
for my $jenkins ( @jenkins ) {
push @jobs, $jenkins->jobs($filter);
}
}
if( ! @jobs ) {
return [$filter] if $action eq 'create';
die "No jobs found for pattern /$filter/\n";
}
}
return $jobs = \@jobs;
}
}
}
sub login {
for my $jenkins ( @jenkins ) {
$jenkins->login();
}
}
sub list {
my ( $jobs, $args ) = @_;
for my $job ( @$jobs ) {
my $markers = "";
$markers .= "*" if $job->is_running;
$markers .= "?" if $job->was_aborted;
$markers .= "+" if $job->is_queued;
print colorize($job->color, $job->name), "$markers $job->{url}\n";
}
}
sub nodes {
my ( $nodes, $args ) = @_;
for my $node ( @$nodes ) {
next if $opts{idle} && $node->is_running;
next if $opts{busy} && !$node->is_running;
next if $opts{online} && $node->offline;
next if $opts{offline} && !$node->offline;
my $markers = "";
$markers .= "*" if $node->is_running;
$markers .= "?" if $node->offline && !$node->tempOffline;
print colorize($node->color, $node->name), "$markers @{$node->{labels}}\n";
}
}
sub nodesToggle {
my ( $nodes, $args ) = @_;
my @nodes = grep {
$opts{idle} && !$_->is_running
|| $opts{busy} && $_->is_running
|| $opts{online} && !$_->offline
|| $opts{offline} && $_->offline
} @$nodes;
confirm_multiple("toggleOffline", \@nodes, "node") if @nodes > 1;
for my $node ( @nodes ) {
eval {
$node->toggleOffline()
};
printf "toggleOffline %s: %s\n",$node->name(), $@ ? "ERROR: $@" : "OK";
}
}
sub nodesDelete {
my ( $nodes, $args ) = @_;
my @nodes = grep {
$opts{idle} && !$_->is_running
|| $opts{busy} && $_->is_running
|| $opts{online} && !$_->offline
|| $opts{offline} && $_->offline
} @$nodes;
confirm_multiple("nodeDelete", \@nodes, "node") if @nodes > 1;
for my $node ( @nodes ) {
eval {
$node->remove()
};
printf "nodeDelete %s: %s\n",$node->name(), $@ ? "ERROR: $@" : "OK";
}
}
sub queue {
for my $jenkins ( @jenkins ) {
my $queue = $jenkins->queue();
for my $host ( keys %{$queue->{blocked}} ) {
my $hostStr = $host;
# if hostname will wrap, just truncate the middle
if ( length($host) > 76 ) {
$hostStr = substr($host,0,31) . "..." . substr($host,-31,31);
}
print colorize("bold", colorize("underline", $hostStr)), "\n";
print " ", colorize($_->color, $_->name), "\n" for @{$queue->{blocked}->{$host}};
}
if ( $jenkins->{stuck} ) {
for my $host ( keys %{$queue->{stuck}} ) {
my $hostStr = $host;
# if hostname will wrap, just truncate the middle
if ( length($host) > 76 ) {
$hostStr = substr($host,0,31) . "..." . substr($host,-31,31);
}
print colorize("bold", colorize("red", colorize("underline", $hostStr))), "\n";
print " ", colorize($_->color, $_->name), "\n" for @{$queue->{stuck}->{$host}};
}
}
if ( @{$queue->{running}} ) {
print colorize("bold", colorize("underline", "ALREADY RUNNING")), "\n";
print " ", colorize($_->color, $_->name), "\n" for @{$queue->{running}};
}
if ( @{$queue->{quieted}} ) {
print colorize("bold", colorize("underline", "QUIETED")), "\n";
print " ", colorize($_->color, $_->name), "\n" for @{$queue->{quieted}};
}
}
}
sub tail {
my ( $jobs, $args ) = @_;
require_one($jobs);
my $job = $jobs->[0];
my $cursor = $job->logCursor;
while(1) {
my $content = $cursor->();
last unless defined $content;
print $content;
sleep 1;
}
}
sub history {
my ( $jobs, $args ) = @_;
require_one($jobs);
my $job = $jobs->[0];
my @jobs = $job->history();
for my $job ( @jobs ) {
my $markers = "";
$markers .= "*" if $job->is_running;
$markers .= "?" if $job->was_aborted;
print "#" , $job->number(),
" - ", colorize($job->color, scalar localtime($job->started)),
sprintf("%-2s [%07.03f sec]\n", $markers, $job->duration);
}
}
sub config {
my ( $jobs, $args ) = @_;
require_one($jobs);
my $job = $jobs->[0];
print $job->config();
}
sub create {
my ( $jobs, $args ) = @_;
require_one($jobs);
my $job = $jobs->[0];
my $configFile = shift @$args;
my $config = do {
local $/;
open my $fh, "<$configFile" or die "Could not read config file $configFile: $!";
<$fh>;
};
$jenkins[0]->create($job,$config);
}
sub require_one {
my ( $jobs ) = @_;
if ( @$jobs > 1 ) {
my $prog = File::Basename::basename($0);
my ($pkg, $func) = (caller(1))[0,3];
$func =~ s/$pkg\:://;
die scalar(@$jobs)
. " matches for pattern /$filter/ but only one job can be sent to: $prog $func\nMatches:\n\t"
. join("\n\t", map { $_->{name} } @$jobs )
. "\n";
}
}
sub confirm_multiple {
my ($operation, $jobs, $type) = @_;
$type ||= "job";
return if $jenkins[0]->{yes};
my ($in, $out) = $jenkins[0]->stdio;
while(1 && ! $opts{yes} ) {
print $out "Mutliple ${type}s found for pattern /$filter/\n";
print $out " ", $_->name, "\n" for @$jobs;
print $out "Do you want to $operation all of them? [y/N]: ";
my $ans = <$in>;
chomp($ans);
if( !$ans || $ans =~ /^n/i ) {
exit;
}
if( $ans =~ /^y/i ) {
return;
}
print $out "Sorry, didn't understand \"$ans\"\n";
}
}
sub colorize {
my ( $color ) = shift;
# dont colorize when redirected to non-tty
return @_ unless -t STDOUT;
return color($color), @_, color("reset");
}