├── TODO ├── jenkins ├── GNUmakefile ├── lib └── WWW │ ├── Jenkins │ ├── Node.pm │ └── Job.pm │ └── Jenkins.pm ├── README ├── LICENSE.txt ├── bin └── jenkins └── jenkins-static /TODO: -------------------------------------------------------------------------------- 1 | * add man/perldoc documentation 2 | * make deps variable ie use YAML instead of YAML::Syck if available 3 | * allow tail on older builds 4 | -------------------------------------------------------------------------------- /jenkins: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | bin=$(readlink $0 || echo $0) 3 | dir=$(dirname $bin) 4 | perl=$(which perl) 5 | exec $perl -I$dir/lib $dir/bin/jenkins "$@" -------------------------------------------------------------------------------- /GNUmakefile: -------------------------------------------------------------------------------- 1 | SRC=bin/jenkins $(shell find lib -name \*.pm) 2 | 3 | .PHONY: static 4 | static: $(SRC) 5 | head -1 bin/jenkins > jenkins-static 6 | find lib -depth -name \*.pm | xargs cat | grep -v "^use WWW::Jenkins" >> jenkins-static 7 | echo "package main;" >> jenkins-static 8 | cat bin/jenkins | grep -v "^use WWW::Jenkins" >> jenkins-static 9 | chmod 755 ./jenkins-static -------------------------------------------------------------------------------- /lib/WWW/Jenkins/Node.pm: -------------------------------------------------------------------------------- 1 | package WWW::Jenkins::Node; 2 | 3 | # Copyright 2012 Netflix, Inc. 4 | # 5 | # Licensed under the Apache License, Version 2.0 (the "License"); 6 | # you may not use this file except in compliance with the License. 7 | # You may obtain a copy of the License at 8 | # 9 | # http://www.apache.org/licenses/LICENSE-2.0 10 | # 11 | # Unless required by applicable law or agreed to in writing, software 12 | # distributed under the License is distributed on an "AS IS" BASIS, 13 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | # See the License for the specific language governing permissions and 15 | # limitations under the License. 16 | 17 | use strict; 18 | use warnings; 19 | use WWW::Jenkins; 20 | use WWW::Jenkins::Job; 21 | 22 | sub new { 23 | my $class = shift; 24 | my $self = bless { @_ }, $class; 25 | for my $required ( qw(name jenkins) ) { 26 | defined $self->{$required} || die "no $required parameter to WWW::Jenkins::Node->new()"; 27 | } 28 | $self->{url} ||= $self->j->{baseuri} . "/computer/$self->{name}"; 29 | 30 | $self->{color} = $self->{offline} ? "red" : "green"; 31 | my $busy = 0; 32 | for my $exec ( @{$self->{executors}} ) { 33 | $busy++ unless $exec->{idle}; 34 | } 35 | $self->{offline} = $self->{offline}; 36 | $self->{temporarilyOffline} = $self->{temporarilyOffline}; 37 | $self->{busy} = $busy; 38 | $self->{executors} = $self->{numExecutors}; 39 | return $self; 40 | } 41 | 42 | sub name { 43 | return shift->{"name"}; 44 | } 45 | 46 | sub is_running { 47 | return shift->{busy}; 48 | } 49 | 50 | sub offline { 51 | return shift->{offline}; 52 | } 53 | 54 | sub tempOffline { 55 | return shift->{temporarilyOffline}; 56 | } 57 | 58 | sub toggleOffline { 59 | my $self = shift; 60 | my $resp = $self->ua->post("$self->{url}/toggleOffline", {offlineMessage => ""}); 61 | if( $resp->is_error ) { 62 | die "Failed to toggleOffline $self->{name}, got error: " . $resp->status_line; 63 | } 64 | return 1; 65 | } 66 | 67 | sub remove { 68 | my $self = shift; 69 | my $resp = $self->ua->post("$self->{url}/doDelete", {}); 70 | if( $resp->is_error ) { 71 | die "Failed to nodeDelete $self->{name}, got error: " . $resp->status_line; 72 | } 73 | return 1; 74 | } 75 | 76 | *copy = *WWW::Jenkins::Job::copy; 77 | *j = *WWW::Jenkins::Job::j; 78 | *ua = *WWW::Jenkins::Job::ua; 79 | *color = *WWW::Jenkins::Job::color; 80 | 81 | if ( 0 ) { # fixed use only once nonsense 82 | copy(); j(); ua(); color(); 83 | } 84 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | Simple Jenkins command line interface written in perl. 2 | 3 | USAGE 4 | ---------------------------------------------------------------------------- 5 | $ jenkins --help 6 | Usage: ./bin/jenkins [options] [command] [] 7 | 8 | Global Options: 9 | --baseuri=: base uri to jenkins server [http://jenkins] 10 | --stoplight: make blue builds green [off] 11 | --job=: specify a job name, can be repeated 12 | --view=: specify a list of jobs by view 13 | 14 | Commands: 15 | ls|list []: show status of builds, optionally filter on pattern 16 | start : start job 17 | stop : stop job 18 | tail : tail the most recent build log for a job 19 | disable : disable job 20 | enable : enable a job 21 | wipeout : delete current build workspace for a job 22 | q|queue: shows pending build queue grouped by build-slaves 23 | hist|history: list history of builds for a job 24 | conf|config: dump config.xml for a job 25 | create : create/update new jenkins job from config.xml 26 | 27 | * Note can be any regular expression to match jobs in your 28 | default job list/view 29 | 30 | CONFIG FILE (in YAML format) 31 | ---------------------------------------------------------------------------- 32 | 33 | $ cat ~/.jenkins 34 | baseuri: http://jenkins.build.host 35 | jobs: 36 | - MyJob-1 37 | - MyJob-2 38 | - MyJob-3 39 | stoplight: 1 40 | # ssl_opts is any option listed in "perldoc IO::Socket::SSL" 41 | ssl_opts: 42 | # by default we ignore invalid certs; set to nil to validate 43 | SSL_verify_callback: 44 | SSL_version: SSLv3 45 | 46 | STATIC SCRIPT 47 | ---------------------------------------------------------------------------- 48 | to fetch and run the script without having to install the libraries you can 49 | just run: 50 | curl -L https://raw.githubusercontent.com/Netflix-Skunkworks/jenkins-cli/master/jenkins-static > ./jenkins 51 | chmod 755 ./jenkins 52 | 53 | COPYRIGHT and LICENSE 54 | ---------------------------------------------------------------------------- 55 | Copyright 2013 Netflix, Inc. 56 | 57 | Licensed under the Apache License, Version 2.0 (the "License"); 58 | you may not use this file except in compliance with the License. 59 | You may obtain a copy of the License at 60 | 61 | http://www.apache.org/licenses/LICENSE-2.0 62 | 63 | Unless required by applicable law or agreed to in writing, software 64 | distributed under the License is distributed on an "AS IS" BASIS, 65 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 66 | See the License for the specific language governing permissions and 67 | limitations under the License. 68 | 69 | 70 | -------------------------------------------------------------------------------- /lib/WWW/Jenkins/Job.pm: -------------------------------------------------------------------------------- 1 | package WWW::Jenkins::Job; 2 | 3 | # Copyright 2012 Netflix, Inc. 4 | # 5 | # Licensed under the Apache License, Version 2.0 (the "License"); 6 | # you may not use this file except in compliance with the License. 7 | # You may obtain a copy of the License at 8 | # 9 | # http://www.apache.org/licenses/LICENSE-2.0 10 | # 11 | # Unless required by applicable law or agreed to in writing, software 12 | # distributed under the License is distributed on an "AS IS" BASIS, 13 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | # See the License for the specific language governing permissions and 15 | # limitations under the License. 16 | 17 | use strict; 18 | use warnings; 19 | 20 | sub new { 21 | my $class = shift; 22 | my $self = bless { @_ }, $class; 23 | for my $required ( qw(name jenkins url color) ) { 24 | defined $self->{$required} || die "no $required parameter to WWW::Jenkins::Job->new()"; 25 | } 26 | $self->{inQueue} ||= 0; 27 | return $self; 28 | } 29 | 30 | sub copy { 31 | my ( $self ) = shift; 32 | return bless { %$self, @_ }, ref($self); 33 | } 34 | 35 | sub j { 36 | return shift->{jenkins}; 37 | } 38 | 39 | sub ua { 40 | return shift->j->{ua}; 41 | } 42 | 43 | sub name { 44 | return shift->{"name"}; 45 | } 46 | 47 | # turns the jenkins 'color' attribute into a color 48 | # suitable for encoding in Term::ANSIColor. 49 | # All aborted builds are marked as red 50 | # ... these are the options we have to work with in ANSIColor 51 | # attributes: reset, bold, dark, faint, underline, blink, reverse and concealed. 52 | # foreground: black, red, green, yellow, blue, magenta, cyan and white. 53 | # background: on_black, on_red, on_green, on_yellow, on_blue, on_magenta, on_cyan and on_white 54 | 55 | sub color { 56 | my ( $self ) = @_; 57 | my $color = $self->{color}; 58 | $color =~ s/_anime$//; 59 | $color = "green" if $self->j->{stoplight} && $color eq 'blue'; 60 | $color = 'faint' if $color eq 'disabled'; 61 | $color = 'red' if $color eq 'aborted'; 62 | $color = 'faint' if $color eq 'grey'; 63 | $color = 'faint' if $color eq 'notbuilt'; 64 | return $color; 65 | } 66 | 67 | sub number { 68 | my ( $self ) = @_; 69 | my $lb = $self->{lastBuild} ||= {}; 70 | return $lb->{number} if defined $lb->{number}; 71 | 72 | if( defined $lb->{url} ) { 73 | my ( $num ) = ( $lb->{url} =~ m{/(\d+)/?$} ); 74 | return $lb->{number} = $num if defined $num; 75 | } 76 | $self->_load_lastBuild; 77 | return $lb->{number}; 78 | } 79 | 80 | sub started { 81 | my ( $self ) = shift; 82 | my $lb = $self->{lastBuild} ||= {}; 83 | return $lb->{timestamp} / 1000 if defined $lb->{timestamp}; 84 | $self->_load_lastBuild; 85 | return $lb->{timestamp} / 1000; 86 | } 87 | 88 | sub duration { 89 | my ( $self ) = shift; 90 | my $lb = $self->{lastBuild} ||= {}; 91 | return $lb->{duration} / 1000 if defined $lb->{duration}; 92 | $self->_load_lastBuild; 93 | return $lb->{duration} / 1000; 94 | } 95 | 96 | sub _load_lastBuild { 97 | my ( $self ) = shift; 98 | my $uri = "$self->{url}/api/json?depth=0&tree=lastBuild[url,duration,timestamp,number]"; 99 | my $res = $self->ua->get($uri); 100 | my $data = WWW::Jenkins::parse_json($res->decoded_content()); 101 | return %{$self->{lastBuild}} = %{$data->{lastBuild}}; 102 | } 103 | 104 | sub start { 105 | my ( $self, $params ) = @_; 106 | $self->j->login(); 107 | my @params; 108 | if ( $self->{actions} ) { 109 | for my $action ( @{$self->{actions}} ) { 110 | if ( exists $action->{parameterDefinitions} ) { 111 | for my $param ( @{$action->{parameterDefinitions}} ) { 112 | if ( exists $params->{$param->{name}} ) { 113 | push @params, { "name" => $param->{name}, "value" => $params->{$param->{name}} }; 114 | } 115 | else { 116 | push @params, { "name" => $param->{name}, "value" => $param->{defaultParameterValue}->{value} }; 117 | } 118 | } 119 | } 120 | } 121 | } 122 | my $resp = $self->ua->post("$self->{url}/build", {delay => "0sec", json=> WWW::Jenkins::encode_json({"parameter" => \@params})}); 123 | if( $resp->is_error ) { 124 | die "Failed to start $self->{name}, got error: " . $resp->status_line; 125 | } 126 | return 1; 127 | } 128 | 129 | sub stop { 130 | my ( $self ) = @_; 131 | 132 | die "job " . $self->name() . " has never been run" 133 | unless $self->{lastBuild}; 134 | 135 | # dont stop something not running 136 | return 1 unless $self->is_running(); 137 | 138 | $self->j->login(); 139 | my $resp = $self->ua->post("$self->{lastBuild}->{url}/stop", {}); 140 | if( $resp->is_error ) { 141 | die "Failed to stop $self->{name}, got error: " . $resp->status_line; 142 | } 143 | return 1; 144 | } 145 | 146 | sub is_running { 147 | my ( $self ) = @_; 148 | return $self->{color} =~ /_anime/ ? 1 : 0; 149 | } 150 | 151 | sub is_queued { 152 | my ( $self ) = @_; 153 | return $self->{inQueue} ? 1 : 0; 154 | } 155 | 156 | sub was_aborted { 157 | my ( $self ) = @_; 158 | return $self->{color} eq 'aborted'; 159 | } 160 | 161 | sub wipeout { 162 | my ( $self ) = @_; 163 | $self->j->login(); 164 | my $resp = $self->ua->post("$self->{url}/doWipeOutWorkspace", {}); 165 | if( $resp->is_error ) { 166 | die "Failed to wipeout $self->{name}, got error: " . $resp->status_line; 167 | } 168 | return 1; 169 | } 170 | 171 | sub logCursor { 172 | my ( $self ) = @_; 173 | die "job " . $self->name() . " has never been run" 174 | unless $self->{lastBuild}; 175 | my $res = undef; 176 | return sub { 177 | if( !$res ) { 178 | $res = $self->ua->post( 179 | "$self->{lastBuild}->{url}/logText/progressiveText", { start => 0 } 180 | ) 181 | } 182 | elsif( $res->header("X-More-Data") && $res->header("X-More-Data") eq 'true' ) { 183 | $res = $self->ua->post( 184 | "$self->{lastBuild}->{url}/logText/progressiveText", { 185 | start => $res->header("X-Text-Size") 186 | } 187 | ); 188 | } 189 | else { 190 | # there was a previous response but X-More-Data not set, so we are done 191 | return undef; 192 | } 193 | return $res->decoded_content || ""; 194 | } 195 | } 196 | 197 | sub disable { 198 | my ( $self ) = @_; 199 | $self->j->login(); 200 | my $resp = $self->ua->post("$self->{url}/disable", {}); 201 | if( $resp->is_error ) { 202 | die "Failed to disable $self->{name}, got error: " . $resp->status_line; 203 | } 204 | return 1; 205 | } 206 | 207 | sub enable { 208 | my ( $self ) = @_; 209 | $self->j->login(); 210 | my $resp = $self->ua->post("$self->{url}/enable", {}); 211 | if( $resp->is_error ) { 212 | die "Failed to enable $self->{name}, got error: " . $resp->status_line; 213 | } 214 | return 1; 215 | } 216 | 217 | sub config { 218 | my ( $self, $content ) = @_; 219 | $self->j->login(); 220 | my $url = "$self->{url}/config.xml"; 221 | my $resp; 222 | if( $content ) { 223 | my $req = HTTP::Request->new("POST", $url); 224 | $req->content($content); 225 | $resp = $self->ua->request($req); 226 | } 227 | else { 228 | $resp = $self->ua->get($url, {}); 229 | } 230 | if( $resp->is_error ) { 231 | die "Failed get/set config.xml for $self->{name}, got error: " . $resp->status_line; 232 | } 233 | return $resp->decoded_content(); 234 | } 235 | 236 | sub millis { 237 | eval "use Time::HiRes"; 238 | if( $@ ) { 239 | return time() * 1000; 240 | } 241 | else { 242 | return Time::HiRes::time() * 1000 243 | } 244 | } 245 | 246 | 247 | 248 | sub history { 249 | my ( $self ) = @_; 250 | my $res = $self->ua->get("$self->{url}/api/json?depth=11&tree=builds[result,url,number,building,timestamp,duration]"); 251 | my $data = WWW::Jenkins::parse_json($res->decoded_content()); 252 | my @out; 253 | for my $build ( @{$data->{builds}} ) { 254 | my $color; 255 | if( $build->{building} ) { 256 | $color = $self->{color}; 257 | $build->{duration} ||= $self->millis - $build->{timestamp} 258 | } 259 | else { 260 | $color = 261 | $build->{result} =~ /SUCCESS/ ? "blue" : 262 | $build->{result} =~ /ABORTED/ ? "aborted" : 263 | $build->{result} =~ /FAILURE/ ? "red" : 264 | "grey" ; 265 | } 266 | warn("unknown result: $build->{result}\n") if $color eq 'grey'; 267 | push @out, $self->copy( 268 | color => $color, 269 | inQueue => 0, 270 | lastBuild => $build, 271 | ); 272 | } 273 | return wantarray ? @out : \@out; 274 | } 275 | 276 | 1; 277 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | 2 | Apache License 3 | Version 2.0, January 2004 4 | http://www.apache.org/licenses/ 5 | 6 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 7 | 8 | 1. Definitions. 9 | 10 | "License" shall mean the terms and conditions for use, reproduction, 11 | and distribution as defined by Sections 1 through 9 of this document. 12 | 13 | "Licensor" shall mean the copyright owner or entity authorized by 14 | the copyright owner that is granting the License. 15 | 16 | "Legal Entity" shall mean the union of the acting entity and all 17 | other entities that control, are controlled by, or are under common 18 | control with that entity. For the purposes of this definition, 19 | "control" means (i) the power, direct or indirect, to cause the 20 | direction or management of such entity, whether by contract or 21 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 22 | outstanding shares, or (iii) beneficial ownership of such entity. 23 | 24 | "You" (or "Your") shall mean an individual or Legal Entity 25 | exercising permissions granted by this License. 26 | 27 | "Source" form shall mean the preferred form for making modifications, 28 | including but not limited to software source code, documentation 29 | source, and configuration files. 30 | 31 | "Object" form shall mean any form resulting from mechanical 32 | transformation or translation of a Source form, including but 33 | not limited to compiled object code, generated documentation, 34 | and conversions to other media types. 35 | 36 | "Work" shall mean the work of authorship, whether in Source or 37 | Object form, made available under the License, as indicated by a 38 | copyright notice that is included in or attached to the work 39 | (an example is provided in the Appendix below). 40 | 41 | "Derivative Works" shall mean any work, whether in Source or Object 42 | form, that is based on (or derived from) the Work and for which the 43 | editorial revisions, annotations, elaborations, or other modifications 44 | represent, as a whole, an original work of authorship. For the purposes 45 | of this License, Derivative Works shall not include works that remain 46 | separable from, or merely link (or bind by name) to the interfaces of, 47 | the Work and Derivative Works thereof. 48 | 49 | "Contribution" shall mean any work of authorship, including 50 | the original version of the Work and any modifications or additions 51 | to that Work or Derivative Works thereof, that is intentionally 52 | submitted to Licensor for inclusion in the Work by the copyright owner 53 | or by an individual or Legal Entity authorized to submit on behalf of 54 | the copyright owner. For the purposes of this definition, "submitted" 55 | means any form of electronic, verbal, or written communication sent 56 | to the Licensor or its representatives, including but not limited to 57 | communication on electronic mailing lists, source code control systems, 58 | and issue tracking systems that are managed by, or on behalf of, the 59 | Licensor for the purpose of discussing and improving the Work, but 60 | excluding communication that is conspicuously marked or otherwise 61 | designated in writing by the copyright owner as "Not a Contribution." 62 | 63 | "Contributor" shall mean Licensor and any individual or Legal Entity 64 | on behalf of whom a Contribution has been received by Licensor and 65 | subsequently incorporated within the Work. 66 | 67 | 2. Grant of Copyright License. Subject to the terms and conditions of 68 | this License, each Contributor hereby grants to You a perpetual, 69 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 70 | copyright license to reproduce, prepare Derivative Works of, 71 | publicly display, publicly perform, sublicense, and distribute the 72 | Work and such Derivative Works in Source or Object form. 73 | 74 | 3. Grant of Patent License. Subject to the terms and conditions of 75 | this License, each Contributor hereby grants to You a perpetual, 76 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 77 | (except as stated in this section) patent license to make, have made, 78 | use, offer to sell, sell, import, and otherwise transfer the Work, 79 | where such license applies only to those patent claims licensable 80 | by such Contributor that are necessarily infringed by their 81 | Contribution(s) alone or by combination of their Contribution(s) 82 | with the Work to which such Contribution(s) was submitted. If You 83 | institute patent litigation against any entity (including a 84 | cross-claim or counterclaim in a lawsuit) alleging that the Work 85 | or a Contribution incorporated within the Work constitutes direct 86 | or contributory patent infringement, then any patent licenses 87 | granted to You under this License for that Work shall terminate 88 | as of the date such litigation is filed. 89 | 90 | 4. Redistribution. You may reproduce and distribute copies of the 91 | Work or Derivative Works thereof in any medium, with or without 92 | modifications, and in Source or Object form, provided that You 93 | meet the following conditions: 94 | 95 | (a) You must give any other recipients of the Work or 96 | Derivative Works a copy of this License; and 97 | 98 | (b) You must cause any modified files to carry prominent notices 99 | stating that You changed the files; and 100 | 101 | (c) You must retain, in the Source form of any Derivative Works 102 | that You distribute, all copyright, patent, trademark, and 103 | attribution notices from the Source form of the Work, 104 | excluding those notices that do not pertain to any part of 105 | the Derivative Works; and 106 | 107 | (d) If the Work includes a "NOTICE" text file as part of its 108 | distribution, then any Derivative Works that You distribute must 109 | include a readable copy of the attribution notices contained 110 | within such NOTICE file, excluding those notices that do not 111 | pertain to any part of the Derivative Works, in at least one 112 | of the following places: within a NOTICE text file distributed 113 | as part of the Derivative Works; within the Source form or 114 | documentation, if provided along with the Derivative Works; or, 115 | within a display generated by the Derivative Works, if and 116 | wherever such third-party notices normally appear. The contents 117 | of the NOTICE file are for informational purposes only and 118 | do not modify the License. You may add Your own attribution 119 | notices within Derivative Works that You distribute, alongside 120 | or as an addendum to the NOTICE text from the Work, provided 121 | that such additional attribution notices cannot be construed 122 | as modifying the License. 123 | 124 | You may add Your own copyright statement to Your modifications and 125 | may provide additional or different license terms and conditions 126 | for use, reproduction, or distribution of Your modifications, or 127 | for any such Derivative Works as a whole, provided Your use, 128 | reproduction, and distribution of the Work otherwise complies with 129 | the conditions stated in this License. 130 | 131 | 5. Submission of Contributions. Unless You explicitly state otherwise, 132 | any Contribution intentionally submitted for inclusion in the Work 133 | by You to the Licensor shall be under the terms and conditions of 134 | this License, without any additional terms or conditions. 135 | Notwithstanding the above, nothing herein shall supersede or modify 136 | the terms of any separate license agreement you may have executed 137 | with Licensor regarding such Contributions. 138 | 139 | 6. Trademarks. This License does not grant permission to use the trade 140 | names, trademarks, service marks, or product names of the Licensor, 141 | except as required for reasonable and customary use in describing the 142 | origin of the Work and reproducing the content of the NOTICE file. 143 | 144 | 7. Disclaimer of Warranty. Unless required by applicable law or 145 | agreed to in writing, Licensor provides the Work (and each 146 | Contributor provides its Contributions) on an "AS IS" BASIS, 147 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 148 | implied, including, without limitation, any warranties or conditions 149 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 150 | PARTICULAR PURPOSE. You are solely responsible for determining the 151 | appropriateness of using or redistributing the Work and assume any 152 | risks associated with Your exercise of permissions under this License. 153 | 154 | 8. Limitation of Liability. In no event and under no legal theory, 155 | whether in tort (including negligence), contract, or otherwise, 156 | unless required by applicable law (such as deliberate and grossly 157 | negligent acts) or agreed to in writing, shall any Contributor be 158 | liable to You for damages, including any direct, indirect, special, 159 | incidental, or consequential damages of any character arising as a 160 | result of this License or out of the use or inability to use the 161 | Work (including but not limited to damages for loss of goodwill, 162 | work stoppage, computer failure or malfunction, or any and all 163 | other commercial damages or losses), even if such Contributor 164 | has been advised of the possibility of such damages. 165 | 166 | 9. Accepting Warranty or Additional Liability. While redistributing 167 | the Work or Derivative Works thereof, You may choose to offer, 168 | and charge a fee for, acceptance of support, warranty, indemnity, 169 | or other liability obligations and/or rights consistent with this 170 | License. However, in accepting such obligations, You may act only 171 | on Your own behalf and on Your sole responsibility, not on behalf 172 | of any other Contributor, and only if You agree to indemnify, 173 | defend, and hold each Contributor harmless for any liability 174 | incurred by, or claims asserted against, such Contributor by reason 175 | of your accepting any such warranty or additional liability. 176 | 177 | END OF TERMS AND CONDITIONS 178 | 179 | APPENDIX: How to apply the Apache License to your work. 180 | 181 | To apply the Apache License to your work, attach the following 182 | boilerplate notice, with the fields enclosed by brackets "[]" 183 | replaced with your own identifying information. (Don't include 184 | the brackets!) The text should be enclosed in the appropriate 185 | comment syntax for the file format. We also recommend that a 186 | file or class name and description of purpose be included on the 187 | same "printed page" as the copyright notice for easier 188 | identification within third-party archives. 189 | 190 | Copyright 2012 Netflix, Inc. 191 | 192 | Licensed under the Apache License, Version 2.0 (the "License"); 193 | you may not use this file except in compliance with the License. 194 | You may obtain a copy of the License at 195 | 196 | http://www.apache.org/licenses/LICENSE-2.0 197 | 198 | Unless required by applicable law or agreed to in writing, software 199 | distributed under the License is distributed on an "AS IS" BASIS, 200 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 201 | See the License for the specific language governing permissions and 202 | limitations under the License. 203 | -------------------------------------------------------------------------------- /lib/WWW/Jenkins.pm: -------------------------------------------------------------------------------- 1 | package WWW::Jenkins; 2 | use strict; 3 | use warnings; 4 | # Copyright 2012 Netflix, Inc. 5 | # 6 | # Licensed under the Apache License, Version 2.0 (the "License"); 7 | # you may not use this file except in compliance with the License. 8 | # You may obtain a copy of the License at 9 | # 10 | # http://www.apache.org/licenses/LICENSE-2.0 11 | # 12 | # Unless required by applicable law or agreed to in writing, software 13 | # distributed under the License is distributed on an "AS IS" BASIS, 14 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | # See the License for the specific language governing permissions and 16 | # limitations under the License. 17 | 18 | use WWW::Jenkins::Job; 19 | use WWW::Jenkins::Node; 20 | use LWP::UserAgent qw(); 21 | use HTTP::Cookies qw(); 22 | use HTTP::Request qw(); 23 | use Carp qw(croak); 24 | use URI; 25 | 26 | our @CLEANUP; 27 | 28 | sub new { 29 | my $class = shift; 30 | my $self = bless { 31 | # defaults 32 | stoplight => 0, 33 | user => $ENV{USER}, 34 | @_ 35 | }, $class; 36 | 37 | my $UA = $self->{verbose} 38 | ? "WWW::Jenkins::UserAgent" 39 | : "LWP::UserAgent"; 40 | 41 | $self->{baseuri} || die "baseuri option required"; 42 | 43 | 44 | 45 | $self->{ua} ||= $UA->new( 46 | cookie_jar => HTTP::Cookies->new( 47 | file => "$ENV{HOME}/.$self->{user}-".URI->new($self->{baseuri})->host()."-cookies.txt", 48 | autosave => 1, 49 | ), 50 | ssl_opts => { 51 | SSL_verify_callback => sub { 1 }, 52 | $self->{ssl_opts} ? %{$self->{ssl_opts}} : () 53 | } 54 | ); 55 | 56 | return $self; 57 | } 58 | 59 | sub create { 60 | my ($self, $job, $config) = @_; 61 | if( ref($job) ) { 62 | return $job->config($config); 63 | } 64 | 65 | $self->login(); 66 | my $req = HTTP::Request->new("POST", "$self->{baseuri}/createItem?name=$job"); 67 | $req->header("Content-Type" => "application/xml"); 68 | $req->content($config); 69 | my $resp = $self->{ua}->request($req); 70 | if( $resp->is_error ) { 71 | die "Failed to create new job $job, got error: " . $resp->as_string; 72 | } 73 | } 74 | 75 | sub search { 76 | my ($self, $filter) = @_; 77 | my $uri = "$self->{baseuri}/api/json?tree=jobs[name]"; 78 | my $res = $self->{ua}->get($uri); 79 | my @out = (); 80 | if( $res->is_success ) { 81 | my $data = parse_json($res->decoded_content()); 82 | @out = grep { /$filter/ } map { $_->{name} } @{$data->{jobs}}; 83 | } 84 | return wantarray ? @out : \@out; 85 | } 86 | 87 | sub jobs { 88 | my ($self,@jobs) = @_; 89 | 90 | my @out = (); 91 | for my $job ( @jobs ) { 92 | my $uri = "$self->{baseuri}/job/$job/api/json?depth=0&tree=name,inQueue,url,lastBuild[number,url],color,actions[parameterDefinitions[defaultParameterValue[value],name]]"; 93 | my $res = $self->{ua}->get($uri); 94 | if( $res->is_success ) { 95 | my $data = parse_json($res->decoded_content()); 96 | push @out, WWW::Jenkins::Job->new(%$data, jenkins => $self); 97 | } 98 | } 99 | return wantarray ? @out : \@out; 100 | } 101 | 102 | sub nodes { 103 | my ($self, $label) = @_; 104 | $self->login(); 105 | my @out = (); 106 | my $uri = "$self->{baseuri}/computer/(master)/config.xml"; 107 | my $res = $self->{ua}->get($uri); 108 | if( $res->is_success ) { 109 | my $xml = $res->decoded_content(); 110 | 111 | my $res = $self->{ua}->get("$self->{baseuri}/computer/api/json?depth=1&tree=computer[displayName,executors[idle],numExecutors,offline,temporarilyOffline]"); 112 | my $data = WWW::Jenkins::parse_json($res->decoded_content); 113 | my %nodeData = map { $_->{displayName} => $_ } @{$data->{computer}}; 114 | #print "$xml\n"; 115 | my @slaves = ($xml =~ m{(.*?)}sg ); 116 | for my $slave (@slaves) { 117 | my %names = ($slave =~ m{(\s+)(.*?)}sg ); 118 | my $smallest_indent = (sort keys %names)[0]; 119 | my $name = $names{$smallest_indent}; 120 | my ($labels) = ($slave =~ m{}sg ); 121 | if( $label && $labels =~ /$label/ || $name =~ /$label/ ) { 122 | my @labels = sort split /\s+/, $labels; 123 | if ( $name eq 'All' ) { 124 | print "$slave\n"; 125 | use Data::Dumper; 126 | print Dumper(\%names); 127 | print "smallest: \"$smallest_indent\" => $names{$smallest_indent}\n"; 128 | exit; 129 | } 130 | #print "$name => $labels\n"; 131 | push @out, WWW::Jenkins::Node->new(jenkins => $self, name => $name, labels => \@labels, %{$nodeData{$name}}) 132 | } 133 | } 134 | #use Data::Dumper; 135 | #warn Dumper(\@slaves); 136 | #print $xml; 137 | #exit -1; 138 | } 139 | return \@out; 140 | 141 | # my $uri = "$self->{baseuri}/computer/api/json?depth=0&tree=computer[displayName]"; 142 | # my $res = $self->{ua}->get($uri); 143 | # if( $res->is_success ) { 144 | # my $data = parse_json($res->decoded_content()); 145 | # for my $node ( @{$data->{"computer"}} ) { 146 | 147 | # } 148 | # } 149 | 150 | 151 | } 152 | 153 | sub views { 154 | my ($self,@views) = @_; 155 | 156 | my @out = (); 157 | for my $view ( @views ) { 158 | # turns A/B into A/view/B which is needed 159 | # in jenkins uri for subviews 160 | my $viewPath = join("/view/", split '/', $view); 161 | my $uri = "$self->{baseuri}/view/$viewPath/api/json?depth=1&tree=views[name,url],jobs[name,inQueue,url,lastBuild[number,url,timestamp,duration],color]"; 162 | my $res = $self->{ua}->get($uri); 163 | my $data = parse_json($res->decoded_content()); 164 | # we dont know if the view has subviews or it it has jobs, so try for both 165 | # and recurse if we find a subview 166 | if( $data->{jobs} ) { 167 | push @out, WWW::Jenkins::Job->new(%$_, jenkins => $self) for @{$data->{jobs}}; 168 | } 169 | if( $data->{views} ) { 170 | push @out, $self->views("$view/$_->{name}") for @{$data->{views}}; 171 | } 172 | } 173 | return wantarray ? @out : \@out; 174 | } 175 | 176 | sub queue { 177 | my ( $self ) = @_; 178 | my $uri = "$self->{baseuri}/queue/api/json?depth=0&tree=items[task[color,name,url],why,stuck]"; 179 | my $res = $self->{ua}->get($uri); 180 | #print $res->decoded_content; 181 | my $data = parse_json($res->decoded_content()); 182 | my %blocked; 183 | my %stuck; 184 | my @running; 185 | my @quieted; 186 | for my $item ( @{$data->{items}} ) { 187 | my $job = WWW::Jenkins::Job->new( 188 | %{$item->{task}}, 189 | inQueue => 1, 190 | jenkins => $self 191 | ); 192 | 193 | if( $item->{stuck} ) { 194 | if( !$item->{why} ) { 195 | warn "no reason given why $item->{task}->{name} is stuck\n"; 196 | next; 197 | } 198 | if( $item->{why} =~ /([^ ]+) (is|are) offline/ ) { 199 | push @{$stuck{$1}}, $job; 200 | } 201 | else { 202 | warn "don't understand why $item->{task}->{name} is stuck: $item->{why}\n"; 203 | } 204 | } 205 | else { 206 | if( !$item->{why} ) { 207 | warn "no reason given why $item->{task}->{name} is enqueued\n"; 208 | next; 209 | } 210 | if( $item->{why} =~ /Waiting for next available executor on (.*)/ ) { 211 | push @{$blocked{$1}}, $job; 212 | } 213 | elsif( $item->{why} =~ /already in progress/ ) { 214 | push @running, $job; 215 | } 216 | elsif( $item->{why} =~ /quiet period/ ) { 217 | push @quieted, $job; 218 | } 219 | else { 220 | warn "don't understand why $item->{task}->{name} is enqueued: $item->{why}\n"; 221 | } 222 | } 223 | } 224 | return { 225 | blocked => \%blocked, 226 | stuck => \%stuck, 227 | running => \@running, 228 | quieted => \@quieted, 229 | }; 230 | } 231 | 232 | sub login { 233 | my ( $self ) = @_; 234 | return if $self->{logged_in}; 235 | # FIXME there has to be a better way to tell if we 236 | # are already logged in ... 237 | # just load the page with the smallest content that I could find 238 | # and check for a "log in" string to indicate the user is not 239 | # logged in already 240 | my $res = $self->{ua}->get("$self->{baseuri}/user/$self->{user}/?"); 241 | if ( $res->decoded_content =~ />log in{ua}->post( 243 | "$self->{baseuri}/j_acegi_security_check", { 244 | j_username => $self->{user}, 245 | j_password => $self->password(), 246 | } 247 | ); 248 | $self->{ua}->get("$self->{baseuri}/user/$self->{user}/?"); 249 | $self->{ua}->cookie_jar->scan( 250 | sub { 251 | my @args = @_; 252 | # dont discard cookies, so we dont get prompted for a password everytime 253 | $args[9] = 0; 254 | $self->{ua}->cookie_jar->set_cookie(@args); 255 | } 256 | ); 257 | } 258 | $self->{logged_in}++; 259 | return; 260 | } 261 | 262 | sub stdio { 263 | my $self = shift; 264 | my ($in, $out); 265 | if( !-t STDIN || !-t STDOUT ) { 266 | # stdio missing, so try to use tty directly 267 | my $tty = "/dev/tty" if -e "/dev/tty"; 268 | if( !$tty ) { 269 | my ($ttyBin) = grep { -x $_ } qw(/bin/tty /usr/bin/tty); 270 | if ( $ttyBin ) { 271 | $tty = qx{$ttyBin}; 272 | chomp($tty); 273 | } 274 | } 275 | 276 | if( !$tty ) { 277 | die "Could not determine TTY to read password from, aborting"; 278 | } 279 | open $in, "<$tty" or die "Failed to open tty $tty for input: $!"; 280 | open $out, ">$tty" or die "Failed to open tty $tty for output: $!"; 281 | } 282 | else { 283 | # using stdio 284 | $in = \*STDIN; 285 | $out = \*STDOUT; 286 | } 287 | return ($in, $out); 288 | } 289 | 290 | sub password { 291 | my ( $self ) = @_; 292 | if ( ref($self) && defined $self->{password} ) { 293 | if ( ref($self->{password}) eq 'CODE' ) { 294 | return $self->{password}->($self); 295 | } 296 | return $self->{password}; 297 | } 298 | my ($in, $out) = $self->stdio; 299 | 300 | my $old = select $out; 301 | eval "use Term::ReadKey"; 302 | if( $@ ) { 303 | # no readkey, so try for stty to turn off echoing 304 | my ($sttyBin) = grep { -x $_ } qw(/bin/stty /usr/bin/stty); 305 | if( $sttyBin ) { 306 | push @CLEANUP, sub { 307 | system($sttyBin, "echo"); 308 | }; 309 | system($sttyBin, "-echo"); 310 | } 311 | else { 312 | die "Unable to disable echo on your tty while reading password, aborting"; 313 | } 314 | } 315 | else { 316 | # use readkey to turn off echoing 317 | push @CLEANUP, sub { 318 | Term::ReadKey::ReadMode("restore", $out); 319 | }; 320 | Term::ReadKey::ReadMode("noecho", $out); 321 | } 322 | 323 | my $user = ref($self) eq 'HASH' ? $self->{user} : $ENV{USER}; 324 | print $out "Jenkins Password [$user]: "; 325 | my $pass = <$in>; 326 | $CLEANUP[-1]->(); 327 | print $out "\n"; 328 | chomp($pass); 329 | select $old; 330 | return $pass; 331 | } 332 | 333 | { 334 | 335 | my $parser; 336 | my $encoder; 337 | sub init_json { 338 | # no parser, so find one 339 | eval "use JSON::XS qw()"; 340 | unless( $@ ) { 341 | $parser = JSON::XS->can("decode_json") || JSON::XS->can("from_json"); 342 | $encoder = JSON::XS->can("encode_json") || JSON::XS->can("to_json"); 343 | return; 344 | } 345 | eval "use JSON qw()"; 346 | unless ( $@ ) { 347 | $parser = JSON->can("decode_json") || JSON->can("jsonToObj"); 348 | $encoder = JSON->can("encode_json") || JSON->can("objToJson"); 349 | return; 350 | } 351 | eval "use JSON::DWIW qw()"; 352 | unless ( $@ ) { 353 | $parser = JSON::DWIW->can("from_json"); 354 | $encoder = JSON::DWIW->can("to_json"); 355 | return; 356 | } 357 | eval "use JSON::Syck qw()"; 358 | unless ( $@ ) { 359 | $parser = JSON::Syck->can("Load"); 360 | $encoder = JSON::Syck->can("Dump"); 361 | return; 362 | } 363 | die "No valid JSON parser found, try JSON::XS, JSON, JSON::DWIW, or JSON::Syck"; 364 | } 365 | 366 | sub parse_json { 367 | $parser or init_json(); 368 | my $output = eval { 369 | $parser->(@_) 370 | }; 371 | if( $@ ) { 372 | croak "Failed to parse JSON:\n", @_; 373 | } 374 | return $output; 375 | } 376 | 377 | sub encode_json { 378 | $encoder or init_json(); 379 | my $output = eval { 380 | $encoder->(@_) 381 | }; 382 | if ( $@ ) { 383 | croak "Failed to generate JSON:\n", @_; 384 | } 385 | return $output; 386 | } 387 | } 388 | 389 | END { 390 | for my $cleaner ( @CLEANUP ) { 391 | $cleaner->(); 392 | } 393 | } 394 | 395 | # silly class to make debugging easier 396 | package WWW::Jenkins::UserAgent; 397 | use base qw(LWP::UserAgent); 398 | 399 | sub request { 400 | my $self = shift; 401 | my $req = shift; 402 | my $resp = $self->SUPER::request($req, @_); 403 | print "======================================>\n"; 404 | print $req->as_string; 405 | print "<======================================\n"; 406 | print $resp->as_string; 407 | return $resp; 408 | } 409 | 1; 410 | -------------------------------------------------------------------------------- /bin/jenkins: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | # Copyright 2012 Netflix, Inc. 4 | # 5 | # Licensed under the Apache License, Version 2.0 (the "License"); 6 | # you may not use this file except in compliance with the License. 7 | # You may obtain a copy of the License at 8 | # 9 | # http://www.apache.org/licenses/LICENSE-2.0 10 | # 11 | # Unless required by applicable law or agreed to in writing, software 12 | # distributed under the License is distributed on an "AS IS" BASIS, 13 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | # See the License for the specific language governing permissions and 15 | # limitations under the License. 16 | 17 | 18 | use strict; 19 | use warnings; 20 | 21 | use YAML::Syck; 22 | use Term::ANSIColor; 23 | use Getopt::Long; 24 | use WWW::Jenkins; 25 | use File::Basename qw(); 26 | 27 | $|++; 28 | 29 | sub usage { 30 | my $err = shift || 0; 31 | my $io = $err ? *STDERR : *STDOUT; 32 | 33 | print $io ("-")x76,"\n" if $err; 34 | print $io <] 36 | 37 | Global Options: 38 | --all: search jenkins for job names, ignore jobs in ~/.jenkins 39 | --baseuri=: base uri to jenkins server [http://jenkins] 40 | --stoplight: make blue builds green [off] 41 | --job=: specify a job name, can be repeated 42 | --view=: speficy a list of jobs by view 43 | --yes: always answer yes to any question 44 | --password: prompt for password once 45 | 46 | Commands: 47 | ls|list []: show status of builds, optionally filter on pattern 48 | login: login to all configured jenkins masters 49 | start : start job 50 | stop : stop job 51 | tail : tail the most recent build log for a job 52 | disable : disable job 53 | enable : enable a job 54 | wipeout : delete current build workspace for a job 55 | q|queue: shows pending build queue grouped by build-slaves 56 | hist|history: list history of builds for a job 57 | conf|config: dump config.xml for a job 58 | create : create/update new jenkins job from config.xml 59 | nodes 60 | nodesToggle 61 | nodesDelete 62 | 63 | * Note can be any regular expression to match jobs in your 64 | default job list/view 65 | EOM 66 | exit $err; 67 | } 68 | 69 | my @actions; 70 | my @commands = qw(ls list login start stop tail disable enable wipeout q queue hist history conf config create nodes nodesToggle nodesDelete); 71 | 72 | my %options; 73 | $options{$_} = sub { push @actions, shift } for @commands; 74 | 75 | my %opts = ( 76 | master => "*" 77 | ); 78 | GetOptions( 79 | "help" => sub { usage(0) }, 80 | "all" => \$opts{all}, 81 | "baseuri=s" => \$opts{baseuri}, 82 | "stoplight" => \$opts{stoplight}, 83 | "job=s@" => \$opts{jobs}, 84 | "view=s@" => \$opts{views}, 85 | "yes" => \$opts{yes}, 86 | "color!" => \$opts{color}, 87 | "verbose" => \$opts{verbose}, 88 | "user" => \$opts{user}, 89 | "stuck" => \$opts{stuck}, 90 | "param|p=s@" => \$opts{params}, 91 | "password" => \$opts{password}, 92 | "yes" => \$opts{yes}, 93 | "master=s" => \$opts{master}, 94 | 95 | "online" => \$opts{online}, 96 | "offline" => \$opts{offline}, 97 | "busy" => \$opts{busy}, 98 | "idle" => \$opts{idle}, 99 | 100 | %options, 101 | ) || usage(1); 102 | 103 | for my $key ( keys %opts ) { 104 | delete $opts{$key} unless defined $opts{$key} 105 | } 106 | 107 | my @jenkins = (); 108 | 109 | if( $opts{password} ) { 110 | $opts{password} = WWW::Jenkins->password(); 111 | } 112 | 113 | for my $cfg ( glob("$ENV{HOME}/.jenkins*$opts{master}*" ) ) { 114 | if( ! $opts{baseuri} && -f $cfg ) { 115 | my $config = YAML::Syck::LoadFile($cfg); 116 | $config->{baseuri} ||= "http://jenkins"; 117 | $config->{user} ||= $ENV{USER}; 118 | push @jenkins, WWW::Jenkins->new(%$config, %opts); 119 | } 120 | } 121 | 122 | if( !@jenkins ) { 123 | push @jenkins, WWW::Jenkins->new( baseuri => "http://jenkins", user => $ENV{USER}, %opts) 124 | } 125 | 126 | my @args; 127 | for my $arg ( @ARGV ) { 128 | if( grep { $arg eq $_ } @commands ) { 129 | push @actions, $arg; 130 | } 131 | else { 132 | push @args, $arg; 133 | } 134 | } 135 | 136 | my $filter = shift @args || "."; 137 | 138 | if( !@actions ) { 139 | list(load("list"), @args); 140 | } 141 | else { 142 | for my $action ( @actions ) { 143 | no strict "refs"; 144 | 145 | my $func = *{"main::$action"}; 146 | $func->(load($action), \@args); 147 | } 148 | } 149 | 150 | BEGIN { 151 | # create function aliases 152 | no warnings "once"; 153 | *ls = \&list; 154 | *q = \&queue; 155 | *hist = \&history; 156 | *conf = \&config; 157 | 158 | # these routines are all the same, just loop over all jobs 159 | # and try to run the operation on each job. 160 | for my $func (qw(start stop disable enable wipeout)) { 161 | no strict 'refs'; 162 | *{"main::$func"} = sub { 163 | my ( $jobs, $args ) = @_; 164 | confirm_multiple($func, $jobs) if @$jobs > 1; 165 | for my $job ( @$jobs ) { 166 | eval { 167 | if ( $func eq 'start') { 168 | $job->$func( { map { split /=/, $_, 2 } @{$opts{params}} } ) 169 | } 170 | else { 171 | $job->$func() 172 | } 173 | }; 174 | printf "%s %s: %s\n", ucfirst($func), $job->name(), $@ ? "ERROR: $@" : "OK"; 175 | 176 | } 177 | } 178 | } 179 | }; 180 | 181 | { 182 | my $jobs; 183 | my $nodes; 184 | sub load { 185 | my $action = shift; 186 | return [] if $action eq 'q' || $action eq 'queue' || $action eq 'login'; 187 | if( $action =~ /^nodes/) { 188 | return $nodes if $nodes; 189 | my @nodes; 190 | for my $jenkins ( @jenkins ) { 191 | push @nodes, @{$jenkins->nodes($filter)}; 192 | } 193 | return \@nodes; 194 | } 195 | else { 196 | return $jobs if $jobs; 197 | my @jobs; 198 | for my $jenkins ( @jenkins ) { 199 | my $jobNames = $opts{all} ? $jenkins->search($filter) : $jenkins->{jobs}; 200 | my %uniq; 201 | push @jobs, grep { !$uniq{$_->name}++ } $jenkins->jobs(grep{ /$filter/ } @$jobNames); 202 | push @jobs, grep { !$uniq{$_->name}++ } $jenkins->views(@{$jenkins->{views}}); 203 | } 204 | 205 | if( $filter ) { 206 | @jobs = grep { $_->name =~ /$filter/ } @jobs; 207 | my @exact = grep { $_->name eq $filter } @jobs; 208 | @jobs = @exact if @exact; 209 | 210 | if( ! @jobs ) { 211 | # perhaps the name is not in the config file 212 | # but is a job on the jenkins master 213 | for my $jenkins ( @jenkins ) { 214 | push @jobs, $jenkins->jobs($filter); 215 | } 216 | } 217 | 218 | if( ! @jobs ) { 219 | return [$filter] if $action eq 'create'; 220 | die "No jobs found for pattern /$filter/\n"; 221 | } 222 | } 223 | return $jobs = \@jobs; 224 | } 225 | } 226 | } 227 | 228 | sub login { 229 | for my $jenkins ( @jenkins ) { 230 | $jenkins->login(); 231 | } 232 | } 233 | 234 | sub list { 235 | my ( $jobs, $args ) = @_; 236 | for my $job ( @$jobs ) { 237 | my $markers = ""; 238 | $markers .= "*" if $job->is_running; 239 | $markers .= "?" if $job->was_aborted; 240 | $markers .= "+" if $job->is_queued; 241 | print colorize($job->color, $job->name), "$markers $job->{url}\n"; 242 | } 243 | } 244 | 245 | sub nodes { 246 | my ( $nodes, $args ) = @_; 247 | for my $node ( @$nodes ) { 248 | next if $opts{idle} && $node->is_running; 249 | next if $opts{busy} && !$node->is_running; 250 | next if $opts{online} && $node->offline; 251 | next if $opts{offline} && !$node->offline; 252 | my $markers = ""; 253 | $markers .= "*" if $node->is_running; 254 | $markers .= "?" if $node->offline && !$node->tempOffline; 255 | print colorize($node->color, $node->name), "$markers @{$node->{labels}}\n"; 256 | } 257 | } 258 | 259 | sub nodesToggle { 260 | my ( $nodes, $args ) = @_; 261 | my @nodes = grep { 262 | $opts{idle} && !$_->is_running 263 | || $opts{busy} && $_->is_running 264 | || $opts{online} && !$_->offline 265 | || $opts{offline} && $_->offline 266 | } @$nodes; 267 | confirm_multiple("toggleOffline", \@nodes, "node") if @nodes > 1; 268 | for my $node ( @nodes ) { 269 | eval { 270 | $node->toggleOffline() 271 | }; 272 | printf "toggleOffline %s: %s\n",$node->name(), $@ ? "ERROR: $@" : "OK"; 273 | } 274 | } 275 | 276 | sub nodesDelete { 277 | my ( $nodes, $args ) = @_; 278 | my @nodes = grep { 279 | $opts{idle} && !$_->is_running 280 | || $opts{busy} && $_->is_running 281 | || $opts{online} && !$_->offline 282 | || $opts{offline} && $_->offline 283 | } @$nodes; 284 | confirm_multiple("nodeDelete", \@nodes, "node") if @nodes > 1; 285 | for my $node ( @nodes ) { 286 | eval { 287 | $node->remove() 288 | }; 289 | printf "nodeDelete %s: %s\n",$node->name(), $@ ? "ERROR: $@" : "OK"; 290 | } 291 | } 292 | 293 | sub queue { 294 | for my $jenkins ( @jenkins ) { 295 | my $queue = $jenkins->queue(); 296 | for my $host ( keys %{$queue->{blocked}} ) { 297 | my $hostStr = $host; 298 | # if hostname will wrap, just truncate the middle 299 | if ( length($host) > 76 ) { 300 | $hostStr = substr($host,0,31) . "..." . substr($host,-31,31); 301 | } 302 | print colorize("bold", colorize("underline", $hostStr)), "\n"; 303 | print " ", colorize($_->color, $_->name), "\n" for @{$queue->{blocked}->{$host}}; 304 | } 305 | 306 | if ( $jenkins->{stuck} ) { 307 | for my $host ( keys %{$queue->{stuck}} ) { 308 | my $hostStr = $host; 309 | # if hostname will wrap, just truncate the middle 310 | if ( length($host) > 76 ) { 311 | $hostStr = substr($host,0,31) . "..." . substr($host,-31,31); 312 | } 313 | print colorize("bold", colorize("red", colorize("underline", $hostStr))), "\n"; 314 | print " ", colorize($_->color, $_->name), "\n" for @{$queue->{stuck}->{$host}}; 315 | } 316 | } 317 | 318 | if ( @{$queue->{running}} ) { 319 | print colorize("bold", colorize("underline", "ALREADY RUNNING")), "\n"; 320 | print " ", colorize($_->color, $_->name), "\n" for @{$queue->{running}}; 321 | } 322 | 323 | if ( @{$queue->{quieted}} ) { 324 | print colorize("bold", colorize("underline", "QUIETED")), "\n"; 325 | print " ", colorize($_->color, $_->name), "\n" for @{$queue->{quieted}}; 326 | } 327 | } 328 | } 329 | 330 | 331 | sub tail { 332 | my ( $jobs, $args ) = @_; 333 | require_one($jobs); 334 | my $job = $jobs->[0]; 335 | my $cursor = $job->logCursor; 336 | while(1) { 337 | my $content = $cursor->(); 338 | last unless defined $content; 339 | print $content; 340 | sleep 1; 341 | } 342 | } 343 | 344 | sub history { 345 | my ( $jobs, $args ) = @_; 346 | require_one($jobs); 347 | my $job = $jobs->[0]; 348 | my @jobs = $job->history(); 349 | for my $job ( @jobs ) { 350 | my $markers = ""; 351 | $markers .= "*" if $job->is_running; 352 | $markers .= "?" if $job->was_aborted; 353 | print "#" , $job->number(), 354 | " - ", colorize($job->color, scalar localtime($job->started)), 355 | sprintf("%-2s [%07.03f sec]\n", $markers, $job->duration); 356 | } 357 | } 358 | 359 | sub config { 360 | my ( $jobs, $args ) = @_; 361 | require_one($jobs); 362 | my $job = $jobs->[0]; 363 | print $job->config(); 364 | } 365 | 366 | sub create { 367 | my ( $jobs, $args ) = @_; 368 | require_one($jobs); 369 | my $job = $jobs->[0]; 370 | my $configFile = shift @$args; 371 | my $config = do { 372 | local $/; 373 | open my $fh, "<$configFile" or die "Could not read config file $configFile: $!"; 374 | <$fh>; 375 | }; 376 | $jenkins[0]->create($job,$config); 377 | } 378 | 379 | sub require_one { 380 | my ( $jobs ) = @_; 381 | if ( @$jobs > 1 ) { 382 | my $prog = File::Basename::basename($0); 383 | my ($pkg, $func) = (caller(1))[0,3]; 384 | $func =~ s/$pkg\:://; 385 | die scalar(@$jobs) 386 | . " matches for pattern /$filter/ but only one job can be sent to: $prog $func\nMatches:\n\t" 387 | . join("\n\t", map { $_->{name} } @$jobs ) 388 | . "\n"; 389 | } 390 | } 391 | 392 | sub confirm_multiple { 393 | my ($operation, $jobs, $type) = @_; 394 | $type ||= "job"; 395 | return if $jenkins[0]->{yes}; 396 | my ($in, $out) = $jenkins[0]->stdio; 397 | while(1 && ! $opts{yes} ) { 398 | print $out "Mutliple ${type}s found for pattern /$filter/\n"; 399 | print $out " ", $_->name, "\n" for @$jobs; 400 | print $out "Do you want to $operation all of them? [y/N]: "; 401 | my $ans = <$in>; 402 | chomp($ans); 403 | if( !$ans || $ans =~ /^n/i ) { 404 | exit; 405 | } 406 | if( $ans =~ /^y/i ) { 407 | return; 408 | } 409 | print $out "Sorry, didn't understand \"$ans\"\n"; 410 | } 411 | } 412 | 413 | sub colorize { 414 | my ( $color ) = shift; 415 | # dont colorize when redirected to non-tty 416 | return @_ unless -t STDOUT; 417 | return color($color), @_, color("reset"); 418 | } 419 | -------------------------------------------------------------------------------- /jenkins-static: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | package WWW::Jenkins::Job; 3 | 4 | # Copyright 2012 Netflix, Inc. 5 | # 6 | # Licensed under the Apache License, Version 2.0 (the "License"); 7 | # you may not use this file except in compliance with the License. 8 | # You may obtain a copy of the License at 9 | # 10 | # http://www.apache.org/licenses/LICENSE-2.0 11 | # 12 | # Unless required by applicable law or agreed to in writing, software 13 | # distributed under the License is distributed on an "AS IS" BASIS, 14 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | # See the License for the specific language governing permissions and 16 | # limitations under the License. 17 | 18 | use strict; 19 | use warnings; 20 | 21 | sub new { 22 | my $class = shift; 23 | my $self = bless { @_ }, $class; 24 | for my $required ( qw(name jenkins url color) ) { 25 | defined $self->{$required} || die "no $required parameter to WWW::Jenkins::Job->new()"; 26 | } 27 | $self->{inQueue} ||= 0; 28 | return $self; 29 | } 30 | 31 | sub copy { 32 | my ( $self ) = shift; 33 | return bless { %$self, @_ }, ref($self); 34 | } 35 | 36 | sub j { 37 | return shift->{jenkins}; 38 | } 39 | 40 | sub ua { 41 | return shift->j->{ua}; 42 | } 43 | 44 | sub name { 45 | return shift->{"name"}; 46 | } 47 | 48 | # turns the jenkins 'color' attribute into a color 49 | # suitable for encoding in Term::ANSIColor. 50 | # All aborted builds are marked as red 51 | # ... these are the options we have to work with in ANSIColor 52 | # attributes: reset, bold, dark, faint, underline, blink, reverse and concealed. 53 | # foreground: black, red, green, yellow, blue, magenta, cyan and white. 54 | # background: on_black, on_red, on_green, on_yellow, on_blue, on_magenta, on_cyan and on_white 55 | 56 | sub color { 57 | my ( $self ) = @_; 58 | my $color = $self->{color}; 59 | $color =~ s/_anime$//; 60 | $color = "green" if $self->j->{stoplight} && $color eq 'blue'; 61 | $color = 'faint' if $color eq 'disabled'; 62 | $color = 'red' if $color eq 'aborted'; 63 | $color = 'faint' if $color eq 'grey'; 64 | $color = 'faint' if $color eq 'notbuilt'; 65 | return $color; 66 | } 67 | 68 | sub number { 69 | my ( $self ) = @_; 70 | my $lb = $self->{lastBuild} ||= {}; 71 | return $lb->{number} if defined $lb->{number}; 72 | 73 | if( defined $lb->{url} ) { 74 | my ( $num ) = ( $lb->{url} =~ m{/(\d+)/?$} ); 75 | return $lb->{number} = $num if defined $num; 76 | } 77 | $self->_load_lastBuild; 78 | return $lb->{number}; 79 | } 80 | 81 | sub started { 82 | my ( $self ) = shift; 83 | my $lb = $self->{lastBuild} ||= {}; 84 | return $lb->{timestamp} / 1000 if defined $lb->{timestamp}; 85 | $self->_load_lastBuild; 86 | return $lb->{timestamp} / 1000; 87 | } 88 | 89 | sub duration { 90 | my ( $self ) = shift; 91 | my $lb = $self->{lastBuild} ||= {}; 92 | return $lb->{duration} / 1000 if defined $lb->{duration}; 93 | $self->_load_lastBuild; 94 | return $lb->{duration} / 1000; 95 | } 96 | 97 | sub _load_lastBuild { 98 | my ( $self ) = shift; 99 | my $uri = "$self->{url}/api/json?depth=0&tree=lastBuild[url,duration,timestamp,number]"; 100 | my $res = $self->ua->get($uri); 101 | my $data = WWW::Jenkins::parse_json($res->decoded_content()); 102 | return %{$self->{lastBuild}} = %{$data->{lastBuild}}; 103 | } 104 | 105 | sub start { 106 | my ( $self, $params ) = @_; 107 | $self->j->login(); 108 | my @params; 109 | if ( $self->{actions} ) { 110 | for my $action ( @{$self->{actions}} ) { 111 | if ( exists $action->{parameterDefinitions} ) { 112 | for my $param ( @{$action->{parameterDefinitions}} ) { 113 | if ( exists $params->{$param->{name}} ) { 114 | push @params, { "name" => $param->{name}, "value" => $params->{$param->{name}} }; 115 | } 116 | else { 117 | push @params, { "name" => $param->{name}, "value" => $param->{defaultParameterValue}->{value} }; 118 | } 119 | } 120 | } 121 | } 122 | } 123 | my $resp = $self->ua->post("$self->{url}/build", {delay => "0sec", json=> WWW::Jenkins::encode_json({"parameter" => \@params})}); 124 | if( $resp->is_error ) { 125 | die "Failed to start $self->{name}, got error: " . $resp->status_line; 126 | } 127 | return 1; 128 | } 129 | 130 | sub stop { 131 | my ( $self ) = @_; 132 | 133 | die "job " . $self->name() . " has never been run" 134 | unless $self->{lastBuild}; 135 | 136 | # dont stop something not running 137 | return 1 unless $self->is_running(); 138 | 139 | $self->j->login(); 140 | my $resp = $self->ua->post("$self->{lastBuild}->{url}/stop", {}); 141 | if( $resp->is_error ) { 142 | die "Failed to stop $self->{name}, got error: " . $resp->status_line; 143 | } 144 | return 1; 145 | } 146 | 147 | sub is_running { 148 | my ( $self ) = @_; 149 | return $self->{color} =~ /_anime/ ? 1 : 0; 150 | } 151 | 152 | sub is_queued { 153 | my ( $self ) = @_; 154 | return $self->{inQueue} ? 1 : 0; 155 | } 156 | 157 | sub was_aborted { 158 | my ( $self ) = @_; 159 | return $self->{color} eq 'aborted'; 160 | } 161 | 162 | sub wipeout { 163 | my ( $self ) = @_; 164 | $self->j->login(); 165 | my $resp = $self->ua->post("$self->{url}/doWipeOutWorkspace", {}); 166 | if( $resp->is_error ) { 167 | die "Failed to wipeout $self->{name}, got error: " . $resp->status_line; 168 | } 169 | return 1; 170 | } 171 | 172 | sub logCursor { 173 | my ( $self ) = @_; 174 | die "job " . $self->name() . " has never been run" 175 | unless $self->{lastBuild}; 176 | my $res = undef; 177 | return sub { 178 | if( !$res ) { 179 | $res = $self->ua->post( 180 | "$self->{lastBuild}->{url}/logText/progressiveText", { start => 0 } 181 | ) 182 | } 183 | elsif( $res->header("X-More-Data") && $res->header("X-More-Data") eq 'true' ) { 184 | $res = $self->ua->post( 185 | "$self->{lastBuild}->{url}/logText/progressiveText", { 186 | start => $res->header("X-Text-Size") 187 | } 188 | ); 189 | } 190 | else { 191 | # there was a previous response but X-More-Data not set, so we are done 192 | return undef; 193 | } 194 | return $res->decoded_content || ""; 195 | } 196 | } 197 | 198 | sub disable { 199 | my ( $self ) = @_; 200 | $self->j->login(); 201 | my $resp = $self->ua->post("$self->{url}/disable", {}); 202 | if( $resp->is_error ) { 203 | die "Failed to disable $self->{name}, got error: " . $resp->status_line; 204 | } 205 | return 1; 206 | } 207 | 208 | sub enable { 209 | my ( $self ) = @_; 210 | $self->j->login(); 211 | my $resp = $self->ua->post("$self->{url}/enable", {}); 212 | if( $resp->is_error ) { 213 | die "Failed to enable $self->{name}, got error: " . $resp->status_line; 214 | } 215 | return 1; 216 | } 217 | 218 | sub config { 219 | my ( $self, $content ) = @_; 220 | $self->j->login(); 221 | my $url = "$self->{url}/config.xml"; 222 | my $resp; 223 | if( $content ) { 224 | my $req = HTTP::Request->new("POST", $url); 225 | $req->content($content); 226 | $resp = $self->ua->request($req); 227 | } 228 | else { 229 | $resp = $self->ua->get($url, {}); 230 | } 231 | if( $resp->is_error ) { 232 | die "Failed get/set config.xml for $self->{name}, got error: " . $resp->status_line; 233 | } 234 | return $resp->decoded_content(); 235 | } 236 | 237 | sub millis { 238 | eval "use Time::HiRes"; 239 | if( $@ ) { 240 | return time() * 1000; 241 | } 242 | else { 243 | return Time::HiRes::time() * 1000 244 | } 245 | } 246 | 247 | 248 | 249 | sub history { 250 | my ( $self ) = @_; 251 | my $res = $self->ua->get("$self->{url}/api/json?depth=11&tree=builds[result,url,number,building,timestamp,duration]"); 252 | my $data = WWW::Jenkins::parse_json($res->decoded_content()); 253 | my @out; 254 | for my $build ( @{$data->{builds}} ) { 255 | my $color; 256 | if( $build->{building} ) { 257 | $color = $self->{color}; 258 | $build->{duration} ||= $self->millis - $build->{timestamp} 259 | } 260 | else { 261 | $color = 262 | $build->{result} =~ /SUCCESS/ ? "blue" : 263 | $build->{result} =~ /ABORTED/ ? "aborted" : 264 | $build->{result} =~ /FAILURE/ ? "red" : 265 | "grey" ; 266 | } 267 | warn("unknown result: $build->{result}\n") if $color eq 'grey'; 268 | push @out, $self->copy( 269 | color => $color, 270 | inQueue => 0, 271 | lastBuild => $build, 272 | ); 273 | } 274 | return wantarray ? @out : \@out; 275 | } 276 | 277 | 1; 278 | package WWW::Jenkins::Node; 279 | 280 | # Copyright 2012 Netflix, Inc. 281 | # 282 | # Licensed under the Apache License, Version 2.0 (the "License"); 283 | # you may not use this file except in compliance with the License. 284 | # You may obtain a copy of the License at 285 | # 286 | # http://www.apache.org/licenses/LICENSE-2.0 287 | # 288 | # Unless required by applicable law or agreed to in writing, software 289 | # distributed under the License is distributed on an "AS IS" BASIS, 290 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 291 | # See the License for the specific language governing permissions and 292 | # limitations under the License. 293 | 294 | use strict; 295 | use warnings; 296 | 297 | sub new { 298 | my $class = shift; 299 | my $self = bless { @_ }, $class; 300 | for my $required ( qw(name jenkins) ) { 301 | defined $self->{$required} || die "no $required parameter to WWW::Jenkins::Node->new()"; 302 | } 303 | $self->{url} ||= $self->j->{baseuri} . "/computer/$self->{name}"; 304 | 305 | $self->{color} = $self->{offline} ? "red" : "green"; 306 | my $busy = 0; 307 | for my $exec ( @{$self->{executors}} ) { 308 | $busy++ unless $exec->{idle}; 309 | } 310 | $self->{offline} = $self->{offline}; 311 | $self->{temporarilyOffline} = $self->{temporarilyOffline}; 312 | $self->{busy} = $busy; 313 | $self->{executors} = $self->{numExecutors}; 314 | return $self; 315 | } 316 | 317 | sub name { 318 | return shift->{"name"}; 319 | } 320 | 321 | sub is_running { 322 | return shift->{busy}; 323 | } 324 | 325 | sub offline { 326 | return shift->{offline}; 327 | } 328 | 329 | sub tempOffline { 330 | return shift->{temporarilyOffline}; 331 | } 332 | 333 | sub toggleOffline { 334 | my $self = shift; 335 | my $resp = $self->ua->post("$self->{url}/toggleOffline", {offlineMessage => ""}); 336 | if( $resp->is_error ) { 337 | die "Failed to toggleOffline $self->{name}, got error: " . $resp->status_line; 338 | } 339 | return 1; 340 | } 341 | 342 | sub remove { 343 | my $self = shift; 344 | my $resp = $self->ua->post("$self->{url}/doDelete", {}); 345 | if( $resp->is_error ) { 346 | die "Failed to nodeDelete $self->{name}, got error: " . $resp->status_line; 347 | } 348 | return 1; 349 | } 350 | 351 | *copy = *WWW::Jenkins::Job::copy; 352 | *j = *WWW::Jenkins::Job::j; 353 | *ua = *WWW::Jenkins::Job::ua; 354 | *color = *WWW::Jenkins::Job::color; 355 | 356 | if ( 0 ) { # fixed use only once nonsense 357 | copy(); j(); ua(); color(); 358 | } 359 | package WWW::Jenkins; 360 | use strict; 361 | use warnings; 362 | # Copyright 2012 Netflix, Inc. 363 | # 364 | # Licensed under the Apache License, Version 2.0 (the "License"); 365 | # you may not use this file except in compliance with the License. 366 | # You may obtain a copy of the License at 367 | # 368 | # http://www.apache.org/licenses/LICENSE-2.0 369 | # 370 | # Unless required by applicable law or agreed to in writing, software 371 | # distributed under the License is distributed on an "AS IS" BASIS, 372 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 373 | # See the License for the specific language governing permissions and 374 | # limitations under the License. 375 | 376 | use LWP::UserAgent qw(); 377 | use HTTP::Cookies qw(); 378 | use HTTP::Request qw(); 379 | use Carp qw(croak); 380 | use URI; 381 | 382 | our @CLEANUP; 383 | 384 | sub new { 385 | my $class = shift; 386 | my $self = bless { 387 | # defaults 388 | stoplight => 0, 389 | user => $ENV{USER}, 390 | @_ 391 | }, $class; 392 | 393 | my $UA = $self->{verbose} 394 | ? "WWW::Jenkins::UserAgent" 395 | : "LWP::UserAgent"; 396 | 397 | $self->{baseuri} || die "baseuri option required"; 398 | 399 | 400 | 401 | $self->{ua} ||= $UA->new( 402 | cookie_jar => HTTP::Cookies->new( 403 | file => "$ENV{HOME}/.$self->{user}-".URI->new($self->{baseuri})->host()."-cookies.txt", 404 | autosave => 1, 405 | ), 406 | ssl_opts => { 407 | SSL_verify_callback => sub { 1 }, 408 | $self->{ssl_opts} ? %{$self->{ssl_opts}} : () 409 | } 410 | ); 411 | 412 | return $self; 413 | } 414 | 415 | sub create { 416 | my ($self, $job, $config) = @_; 417 | if( ref($job) ) { 418 | return $job->config($config); 419 | } 420 | 421 | $self->login(); 422 | my $req = HTTP::Request->new("POST", "$self->{baseuri}/createItem?name=$job"); 423 | $req->header("Content-Type" => "application/xml"); 424 | $req->content($config); 425 | my $resp = $self->{ua}->request($req); 426 | if( $resp->is_error ) { 427 | die "Failed to create new job $job, got error: " . $resp->as_string; 428 | } 429 | } 430 | 431 | sub search { 432 | my ($self, $filter) = @_; 433 | my $uri = "$self->{baseuri}/api/json?tree=jobs[name]"; 434 | my $res = $self->{ua}->get($uri); 435 | my @out = (); 436 | if( $res->is_success ) { 437 | my $data = parse_json($res->decoded_content()); 438 | @out = grep { /$filter/ } map { $_->{name} } @{$data->{jobs}}; 439 | } 440 | return wantarray ? @out : \@out; 441 | } 442 | 443 | sub jobs { 444 | my ($self,@jobs) = @_; 445 | 446 | my @out = (); 447 | for my $job ( @jobs ) { 448 | my $uri = "$self->{baseuri}/job/$job/api/json?depth=0&tree=name,inQueue,url,lastBuild[number,url],color,actions[parameterDefinitions[defaultParameterValue[value],name]]"; 449 | my $res = $self->{ua}->get($uri); 450 | if( $res->is_success ) { 451 | my $data = parse_json($res->decoded_content()); 452 | push @out, WWW::Jenkins::Job->new(%$data, jenkins => $self); 453 | } 454 | } 455 | return wantarray ? @out : \@out; 456 | } 457 | 458 | sub nodes { 459 | my ($self, $label) = @_; 460 | $self->login(); 461 | my @out = (); 462 | my $uri = "$self->{baseuri}/computer/(master)/config.xml"; 463 | my $res = $self->{ua}->get($uri); 464 | if( $res->is_success ) { 465 | my $xml = $res->decoded_content(); 466 | 467 | my $res = $self->{ua}->get("$self->{baseuri}/computer/api/json?depth=1&tree=computer[displayName,executors[idle],numExecutors,offline,temporarilyOffline]"); 468 | my $data = WWW::Jenkins::parse_json($res->decoded_content); 469 | my %nodeData = map { $_->{displayName} => $_ } @{$data->{computer}}; 470 | #print "$xml\n"; 471 | my @slaves = ($xml =~ m{(.*?)}sg ); 472 | for my $slave (@slaves) { 473 | my %names = ($slave =~ m{(\s+)(.*?)}sg ); 474 | my $smallest_indent = (sort keys %names)[0]; 475 | my $name = $names{$smallest_indent}; 476 | my ($labels) = ($slave =~ m{}sg ); 477 | if( $label && $labels =~ /$label/ || $name =~ /$label/ ) { 478 | my @labels = sort split /\s+/, $labels; 479 | if ( $name eq 'All' ) { 480 | print "$slave\n"; 481 | use Data::Dumper; 482 | print Dumper(\%names); 483 | print "smallest: \"$smallest_indent\" => $names{$smallest_indent}\n"; 484 | exit; 485 | } 486 | #print "$name => $labels\n"; 487 | push @out, WWW::Jenkins::Node->new(jenkins => $self, name => $name, labels => \@labels, %{$nodeData{$name}}) 488 | } 489 | } 490 | #use Data::Dumper; 491 | #warn Dumper(\@slaves); 492 | #print $xml; 493 | #exit -1; 494 | } 495 | return \@out; 496 | 497 | # my $uri = "$self->{baseuri}/computer/api/json?depth=0&tree=computer[displayName]"; 498 | # my $res = $self->{ua}->get($uri); 499 | # if( $res->is_success ) { 500 | # my $data = parse_json($res->decoded_content()); 501 | # for my $node ( @{$data->{"computer"}} ) { 502 | 503 | # } 504 | # } 505 | 506 | 507 | } 508 | 509 | sub views { 510 | my ($self,@views) = @_; 511 | 512 | my @out = (); 513 | for my $view ( @views ) { 514 | # turns A/B into A/view/B which is needed 515 | # in jenkins uri for subviews 516 | my $viewPath = join("/view/", split '/', $view); 517 | my $uri = "$self->{baseuri}/view/$viewPath/api/json?depth=1&tree=views[name,url],jobs[name,inQueue,url,lastBuild[number,url,timestamp,duration],color]"; 518 | my $res = $self->{ua}->get($uri); 519 | my $data = parse_json($res->decoded_content()); 520 | # we dont know if the view has subviews or it it has jobs, so try for both 521 | # and recurse if we find a subview 522 | if( $data->{jobs} ) { 523 | push @out, WWW::Jenkins::Job->new(%$_, jenkins => $self) for @{$data->{jobs}}; 524 | } 525 | if( $data->{views} ) { 526 | push @out, $self->views("$view/$_->{name}") for @{$data->{views}}; 527 | } 528 | } 529 | return wantarray ? @out : \@out; 530 | } 531 | 532 | sub queue { 533 | my ( $self ) = @_; 534 | my $uri = "$self->{baseuri}/queue/api/json?depth=0&tree=items[task[color,name,url],why,stuck]"; 535 | my $res = $self->{ua}->get($uri); 536 | #print $res->decoded_content; 537 | my $data = parse_json($res->decoded_content()); 538 | my %blocked; 539 | my %stuck; 540 | my @running; 541 | my @quieted; 542 | for my $item ( @{$data->{items}} ) { 543 | my $job = WWW::Jenkins::Job->new( 544 | %{$item->{task}}, 545 | inQueue => 1, 546 | jenkins => $self 547 | ); 548 | 549 | if( $item->{stuck} ) { 550 | if( !$item->{why} ) { 551 | warn "no reason given why $item->{task}->{name} is stuck\n"; 552 | next; 553 | } 554 | if( $item->{why} =~ /([^ ]+) (is|are) offline/ ) { 555 | push @{$stuck{$1}}, $job; 556 | } 557 | else { 558 | warn "don't understand why $item->{task}->{name} is stuck: $item->{why}\n"; 559 | } 560 | } 561 | else { 562 | if( !$item->{why} ) { 563 | warn "no reason given why $item->{task}->{name} is enqueued\n"; 564 | next; 565 | } 566 | if( $item->{why} =~ /Waiting for next available executor on (.*)/ ) { 567 | push @{$blocked{$1}}, $job; 568 | } 569 | elsif( $item->{why} =~ /already in progress/ ) { 570 | push @running, $job; 571 | } 572 | elsif( $item->{why} =~ /quiet period/ ) { 573 | push @quieted, $job; 574 | } 575 | else { 576 | warn "don't understand why $item->{task}->{name} is enqueued: $item->{why}\n"; 577 | } 578 | } 579 | } 580 | return { 581 | blocked => \%blocked, 582 | stuck => \%stuck, 583 | running => \@running, 584 | quieted => \@quieted, 585 | }; 586 | } 587 | 588 | sub login { 589 | my ( $self ) = @_; 590 | return if $self->{logged_in}; 591 | # FIXME there has to be a better way to tell if we 592 | # are already logged in ... 593 | # just load the page with the smallest content that I could find 594 | # and check for a "log in" string to indicate the user is not 595 | # logged in already 596 | my $res = $self->{ua}->get("$self->{baseuri}/user/$self->{user}/?"); 597 | if ( $res->decoded_content =~ />log in{ua}->post( 599 | "$self->{baseuri}/j_acegi_security_check", { 600 | j_username => $self->{user}, 601 | j_password => $self->password(), 602 | } 603 | ); 604 | $self->{ua}->get("$self->{baseuri}/user/$self->{user}/?"); 605 | $self->{ua}->cookie_jar->scan( 606 | sub { 607 | my @args = @_; 608 | # dont discard cookies, so we dont get prompted for a password everytime 609 | $args[9] = 0; 610 | $self->{ua}->cookie_jar->set_cookie(@args); 611 | } 612 | ); 613 | } 614 | $self->{logged_in}++; 615 | return; 616 | } 617 | 618 | sub stdio { 619 | my $self = shift; 620 | my ($in, $out); 621 | if( !-t STDIN || !-t STDOUT ) { 622 | # stdio missing, so try to use tty directly 623 | my $tty = "/dev/tty" if -e "/dev/tty"; 624 | if( !$tty ) { 625 | my ($ttyBin) = grep { -x $_ } qw(/bin/tty /usr/bin/tty); 626 | if ( $ttyBin ) { 627 | $tty = qx{$ttyBin}; 628 | chomp($tty); 629 | } 630 | } 631 | 632 | if( !$tty ) { 633 | die "Could not determine TTY to read password from, aborting"; 634 | } 635 | open $in, "<$tty" or die "Failed to open tty $tty for input: $!"; 636 | open $out, ">$tty" or die "Failed to open tty $tty for output: $!"; 637 | } 638 | else { 639 | # using stdio 640 | $in = \*STDIN; 641 | $out = \*STDOUT; 642 | } 643 | return ($in, $out); 644 | } 645 | 646 | sub password { 647 | my ( $self ) = @_; 648 | if ( ref($self) && defined $self->{password} ) { 649 | if ( ref($self->{password}) eq 'CODE' ) { 650 | return $self->{password}->($self); 651 | } 652 | return $self->{password}; 653 | } 654 | my ($in, $out) = $self->stdio; 655 | 656 | my $old = select $out; 657 | eval "use Term::ReadKey"; 658 | if( $@ ) { 659 | # no readkey, so try for stty to turn off echoing 660 | my ($sttyBin) = grep { -x $_ } qw(/bin/stty /usr/bin/stty); 661 | if( $sttyBin ) { 662 | push @CLEANUP, sub { 663 | system($sttyBin, "echo"); 664 | }; 665 | system($sttyBin, "-echo"); 666 | } 667 | else { 668 | die "Unable to disable echo on your tty while reading password, aborting"; 669 | } 670 | } 671 | else { 672 | # use readkey to turn off echoing 673 | push @CLEANUP, sub { 674 | Term::ReadKey::ReadMode("restore", $out); 675 | }; 676 | Term::ReadKey::ReadMode("noecho", $out); 677 | } 678 | 679 | my $user = ref($self) eq 'HASH' ? $self->{user} : $ENV{USER}; 680 | print $out "Jenkins Password [$user]: "; 681 | my $pass = <$in>; 682 | $CLEANUP[-1]->(); 683 | print $out "\n"; 684 | chomp($pass); 685 | select $old; 686 | return $pass; 687 | } 688 | 689 | { 690 | 691 | my $parser; 692 | my $encoder; 693 | sub init_json { 694 | # no parser, so find one 695 | eval "use JSON::XS qw()"; 696 | unless( $@ ) { 697 | $parser = JSON::XS->can("decode_json") || JSON::XS->can("from_json"); 698 | $encoder = JSON::XS->can("encode_json") || JSON::XS->can("to_json"); 699 | return; 700 | } 701 | eval "use JSON qw()"; 702 | unless ( $@ ) { 703 | $parser = JSON->can("decode_json") || JSON->can("jsonToObj"); 704 | $encoder = JSON->can("encode_json") || JSON->can("objToJson"); 705 | return; 706 | } 707 | eval "use JSON::DWIW qw()"; 708 | unless ( $@ ) { 709 | $parser = JSON::DWIW->can("from_json"); 710 | $encoder = JSON::DWIW->can("to_json"); 711 | return; 712 | } 713 | eval "use JSON::Syck qw()"; 714 | unless ( $@ ) { 715 | $parser = JSON::Syck->can("Load"); 716 | $encoder = JSON::Syck->can("Dump"); 717 | return; 718 | } 719 | die "No valid JSON parser found, try JSON::XS, JSON, JSON::DWIW, or JSON::Syck"; 720 | } 721 | 722 | sub parse_json { 723 | $parser or init_json(); 724 | my $output = eval { 725 | $parser->(@_) 726 | }; 727 | if( $@ ) { 728 | croak "Failed to parse JSON:\n", @_; 729 | } 730 | return $output; 731 | } 732 | 733 | sub encode_json { 734 | $encoder or init_json(); 735 | my $output = eval { 736 | $encoder->(@_) 737 | }; 738 | if ( $@ ) { 739 | croak "Failed to generate JSON:\n", @_; 740 | } 741 | return $output; 742 | } 743 | } 744 | 745 | END { 746 | for my $cleaner ( @CLEANUP ) { 747 | $cleaner->(); 748 | } 749 | } 750 | 751 | # silly class to make debugging easier 752 | package WWW::Jenkins::UserAgent; 753 | use base qw(LWP::UserAgent); 754 | 755 | sub request { 756 | my $self = shift; 757 | my $req = shift; 758 | my $resp = $self->SUPER::request($req, @_); 759 | print "======================================>\n"; 760 | print $req->as_string; 761 | print "<======================================\n"; 762 | print $resp->as_string; 763 | return $resp; 764 | } 765 | 1; 766 | package main; 767 | #!/usr/bin/env perl 768 | 769 | # Copyright 2012 Netflix, Inc. 770 | # 771 | # Licensed under the Apache License, Version 2.0 (the "License"); 772 | # you may not use this file except in compliance with the License. 773 | # You may obtain a copy of the License at 774 | # 775 | # http://www.apache.org/licenses/LICENSE-2.0 776 | # 777 | # Unless required by applicable law or agreed to in writing, software 778 | # distributed under the License is distributed on an "AS IS" BASIS, 779 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 780 | # See the License for the specific language governing permissions and 781 | # limitations under the License. 782 | 783 | 784 | use strict; 785 | use warnings; 786 | 787 | use YAML::Syck; 788 | use Term::ANSIColor; 789 | use Getopt::Long; 790 | use File::Basename qw(); 791 | 792 | $|++; 793 | 794 | sub usage { 795 | my $err = shift || 0; 796 | my $io = $err ? *STDERR : *STDOUT; 797 | 798 | print $io ("-")x76,"\n" if $err; 799 | print $io <] 801 | 802 | Global Options: 803 | --all: search jenkins for job names, ignore jobs in ~/.jenkins 804 | --baseuri=: base uri to jenkins server [http://jenkins] 805 | --stoplight: make blue builds green [off] 806 | --job=: specify a job name, can be repeated 807 | --view=: speficy a list of jobs by view 808 | --yes: always answer yes to any question 809 | --password: prompt for password once 810 | 811 | Commands: 812 | ls|list []: show status of builds, optionally filter on pattern 813 | login: login to all configured jenkins masters 814 | start : start job 815 | stop : stop job 816 | tail : tail the most recent build log for a job 817 | disable : disable job 818 | enable : enable a job 819 | wipeout : delete current build workspace for a job 820 | q|queue: shows pending build queue grouped by build-slaves 821 | hist|history: list history of builds for a job 822 | conf|config: dump config.xml for a job 823 | create : create/update new jenkins job from config.xml 824 | nodes 825 | nodesToggle 826 | nodesDelete 827 | 828 | * Note can be any regular expression to match jobs in your 829 | default job list/view 830 | EOM 831 | exit $err; 832 | } 833 | 834 | my @actions; 835 | my @commands = qw(ls list login start stop tail disable enable wipeout q queue hist history conf config create nodes nodesToggle nodesDelete); 836 | 837 | my %options; 838 | $options{$_} = sub { push @actions, shift } for @commands; 839 | 840 | my %opts = ( 841 | master => "*" 842 | ); 843 | GetOptions( 844 | "help" => sub { usage(0) }, 845 | "all" => \$opts{all}, 846 | "baseuri=s" => \$opts{baseuri}, 847 | "stoplight" => \$opts{stoplight}, 848 | "job=s@" => \$opts{jobs}, 849 | "view=s@" => \$opts{views}, 850 | "yes" => \$opts{yes}, 851 | "color!" => \$opts{color}, 852 | "verbose" => \$opts{verbose}, 853 | "user" => \$opts{user}, 854 | "stuck" => \$opts{stuck}, 855 | "param|p=s@" => \$opts{params}, 856 | "password" => \$opts{password}, 857 | "yes" => \$opts{yes}, 858 | "master=s" => \$opts{master}, 859 | 860 | "online" => \$opts{online}, 861 | "offline" => \$opts{offline}, 862 | "busy" => \$opts{busy}, 863 | "idle" => \$opts{idle}, 864 | 865 | %options, 866 | ) || usage(1); 867 | 868 | for my $key ( keys %opts ) { 869 | delete $opts{$key} unless defined $opts{$key} 870 | } 871 | 872 | my @jenkins = (); 873 | 874 | if( $opts{password} ) { 875 | $opts{password} = WWW::Jenkins->password(); 876 | } 877 | 878 | for my $cfg ( glob("$ENV{HOME}/.jenkins*$opts{master}*" ) ) { 879 | if( ! $opts{baseuri} && -f $cfg ) { 880 | my $config = YAML::Syck::LoadFile($cfg); 881 | $config->{baseuri} ||= "http://jenkins"; 882 | $config->{user} ||= $ENV{USER}; 883 | push @jenkins, WWW::Jenkins->new(%$config, %opts); 884 | } 885 | } 886 | 887 | if( !@jenkins ) { 888 | push @jenkins, WWW::Jenkins->new( baseuri => "http://jenkins", user => $ENV{USER}, %opts) 889 | } 890 | 891 | my @args; 892 | for my $arg ( @ARGV ) { 893 | if( grep { $arg eq $_ } @commands ) { 894 | push @actions, $arg; 895 | } 896 | else { 897 | push @args, $arg; 898 | } 899 | } 900 | 901 | my $filter = shift @args || "."; 902 | 903 | if( !@actions ) { 904 | list(load("list"), @args); 905 | } 906 | else { 907 | for my $action ( @actions ) { 908 | no strict "refs"; 909 | 910 | my $func = *{"main::$action"}; 911 | $func->(load($action), \@args); 912 | } 913 | } 914 | 915 | BEGIN { 916 | # create function aliases 917 | no warnings "once"; 918 | *ls = \&list; 919 | *q = \&queue; 920 | *hist = \&history; 921 | *conf = \&config; 922 | 923 | # these routines are all the same, just loop over all jobs 924 | # and try to run the operation on each job. 925 | for my $func (qw(start stop disable enable wipeout)) { 926 | no strict 'refs'; 927 | *{"main::$func"} = sub { 928 | my ( $jobs, $args ) = @_; 929 | confirm_multiple($func, $jobs) if @$jobs > 1; 930 | for my $job ( @$jobs ) { 931 | eval { 932 | if ( $func eq 'start') { 933 | $job->$func( { map { split /=/, $_, 2 } @{$opts{params}} } ) 934 | } 935 | else { 936 | $job->$func() 937 | } 938 | }; 939 | printf "%s %s: %s\n", ucfirst($func), $job->name(), $@ ? "ERROR: $@" : "OK"; 940 | 941 | } 942 | } 943 | } 944 | }; 945 | 946 | { 947 | my $jobs; 948 | my $nodes; 949 | sub load { 950 | my $action = shift; 951 | return [] if $action eq 'q' || $action eq 'queue' || $action eq 'login'; 952 | if( $action =~ /^nodes/) { 953 | return $nodes if $nodes; 954 | my @nodes; 955 | for my $jenkins ( @jenkins ) { 956 | push @nodes, @{$jenkins->nodes($filter)}; 957 | } 958 | return \@nodes; 959 | } 960 | else { 961 | return $jobs if $jobs; 962 | my @jobs; 963 | for my $jenkins ( @jenkins ) { 964 | my $jobNames = $opts{all} ? $jenkins->search($filter) : $jenkins->{jobs}; 965 | my %uniq; 966 | push @jobs, grep { !$uniq{$_->name}++ } $jenkins->jobs(grep{ /$filter/ } @$jobNames); 967 | push @jobs, grep { !$uniq{$_->name}++ } $jenkins->views(@{$jenkins->{views}}); 968 | } 969 | 970 | if( $filter ) { 971 | @jobs = grep { $_->name =~ /$filter/ } @jobs; 972 | my @exact = grep { $_->name eq $filter } @jobs; 973 | @jobs = @exact if @exact; 974 | 975 | if( ! @jobs ) { 976 | # perhaps the name is not in the config file 977 | # but is a job on the jenkins master 978 | for my $jenkins ( @jenkins ) { 979 | push @jobs, $jenkins->jobs($filter); 980 | } 981 | } 982 | 983 | if( ! @jobs ) { 984 | return [$filter] if $action eq 'create'; 985 | die "No jobs found for pattern /$filter/\n"; 986 | } 987 | } 988 | return $jobs = \@jobs; 989 | } 990 | } 991 | } 992 | 993 | sub login { 994 | for my $jenkins ( @jenkins ) { 995 | $jenkins->login(); 996 | } 997 | } 998 | 999 | sub list { 1000 | my ( $jobs, $args ) = @_; 1001 | for my $job ( @$jobs ) { 1002 | my $markers = ""; 1003 | $markers .= "*" if $job->is_running; 1004 | $markers .= "?" if $job->was_aborted; 1005 | $markers .= "+" if $job->is_queued; 1006 | print colorize($job->color, $job->name), "$markers $job->{url}\n"; 1007 | } 1008 | } 1009 | 1010 | sub nodes { 1011 | my ( $nodes, $args ) = @_; 1012 | for my $node ( @$nodes ) { 1013 | next if $opts{idle} && $node->is_running; 1014 | next if $opts{busy} && !$node->is_running; 1015 | next if $opts{online} && $node->offline; 1016 | next if $opts{offline} && !$node->offline; 1017 | my $markers = ""; 1018 | $markers .= "*" if $node->is_running; 1019 | $markers .= "?" if $node->offline && !$node->tempOffline; 1020 | print colorize($node->color, $node->name), "$markers @{$node->{labels}}\n"; 1021 | } 1022 | } 1023 | 1024 | sub nodesToggle { 1025 | my ( $nodes, $args ) = @_; 1026 | my @nodes = grep { 1027 | $opts{idle} && !$_->is_running 1028 | || $opts{busy} && $_->is_running 1029 | || $opts{online} && !$_->offline 1030 | || $opts{offline} && $_->offline 1031 | } @$nodes; 1032 | confirm_multiple("toggleOffline", \@nodes, "node") if @nodes > 1; 1033 | for my $node ( @nodes ) { 1034 | eval { 1035 | $node->toggleOffline() 1036 | }; 1037 | printf "toggleOffline %s: %s\n",$node->name(), $@ ? "ERROR: $@" : "OK"; 1038 | } 1039 | } 1040 | 1041 | sub nodesDelete { 1042 | my ( $nodes, $args ) = @_; 1043 | my @nodes = grep { 1044 | $opts{idle} && !$_->is_running 1045 | || $opts{busy} && $_->is_running 1046 | || $opts{online} && !$_->offline 1047 | || $opts{offline} && $_->offline 1048 | } @$nodes; 1049 | confirm_multiple("nodeDelete", \@nodes, "node") if @nodes > 1; 1050 | for my $node ( @nodes ) { 1051 | eval { 1052 | $node->remove() 1053 | }; 1054 | printf "nodeDelete %s: %s\n",$node->name(), $@ ? "ERROR: $@" : "OK"; 1055 | } 1056 | } 1057 | 1058 | sub queue { 1059 | for my $jenkins ( @jenkins ) { 1060 | my $queue = $jenkins->queue(); 1061 | for my $host ( keys %{$queue->{blocked}} ) { 1062 | my $hostStr = $host; 1063 | # if hostname will wrap, just truncate the middle 1064 | if ( length($host) > 76 ) { 1065 | $hostStr = substr($host,0,31) . "..." . substr($host,-31,31); 1066 | } 1067 | print colorize("bold", colorize("underline", $hostStr)), "\n"; 1068 | print " ", colorize($_->color, $_->name), "\n" for @{$queue->{blocked}->{$host}}; 1069 | } 1070 | 1071 | if ( $jenkins->{stuck} ) { 1072 | for my $host ( keys %{$queue->{stuck}} ) { 1073 | my $hostStr = $host; 1074 | # if hostname will wrap, just truncate the middle 1075 | if ( length($host) > 76 ) { 1076 | $hostStr = substr($host,0,31) . "..." . substr($host,-31,31); 1077 | } 1078 | print colorize("bold", colorize("red", colorize("underline", $hostStr))), "\n"; 1079 | print " ", colorize($_->color, $_->name), "\n" for @{$queue->{stuck}->{$host}}; 1080 | } 1081 | } 1082 | 1083 | if ( @{$queue->{running}} ) { 1084 | print colorize("bold", colorize("underline", "ALREADY RUNNING")), "\n"; 1085 | print " ", colorize($_->color, $_->name), "\n" for @{$queue->{running}}; 1086 | } 1087 | 1088 | if ( @{$queue->{quieted}} ) { 1089 | print colorize("bold", colorize("underline", "QUIETED")), "\n"; 1090 | print " ", colorize($_->color, $_->name), "\n" for @{$queue->{quieted}}; 1091 | } 1092 | } 1093 | } 1094 | 1095 | 1096 | sub tail { 1097 | my ( $jobs, $args ) = @_; 1098 | require_one($jobs); 1099 | my $job = $jobs->[0]; 1100 | my $cursor = $job->logCursor; 1101 | while(1) { 1102 | my $content = $cursor->(); 1103 | last unless defined $content; 1104 | print $content; 1105 | sleep 1; 1106 | } 1107 | } 1108 | 1109 | sub history { 1110 | my ( $jobs, $args ) = @_; 1111 | require_one($jobs); 1112 | my $job = $jobs->[0]; 1113 | my @jobs = $job->history(); 1114 | for my $job ( @jobs ) { 1115 | my $markers = ""; 1116 | $markers .= "*" if $job->is_running; 1117 | $markers .= "?" if $job->was_aborted; 1118 | print "#" , $job->number(), 1119 | " - ", colorize($job->color, scalar localtime($job->started)), 1120 | sprintf("%-2s [%07.03f sec]\n", $markers, $job->duration); 1121 | } 1122 | } 1123 | 1124 | sub config { 1125 | my ( $jobs, $args ) = @_; 1126 | require_one($jobs); 1127 | my $job = $jobs->[0]; 1128 | print $job->config(); 1129 | } 1130 | 1131 | sub create { 1132 | my ( $jobs, $args ) = @_; 1133 | require_one($jobs); 1134 | my $job = $jobs->[0]; 1135 | my $configFile = shift @$args; 1136 | my $config = do { 1137 | local $/; 1138 | open my $fh, "<$configFile" or die "Could not read config file $configFile: $!"; 1139 | <$fh>; 1140 | }; 1141 | $jenkins[0]->create($job,$config); 1142 | } 1143 | 1144 | sub require_one { 1145 | my ( $jobs ) = @_; 1146 | if ( @$jobs > 1 ) { 1147 | my $prog = File::Basename::basename($0); 1148 | my ($pkg, $func) = (caller(1))[0,3]; 1149 | $func =~ s/$pkg\:://; 1150 | die scalar(@$jobs) 1151 | . " matches for pattern /$filter/ but only one job can be sent to: $prog $func\nMatches:\n\t" 1152 | . join("\n\t", map { $_->{name} } @$jobs ) 1153 | . "\n"; 1154 | } 1155 | } 1156 | 1157 | sub confirm_multiple { 1158 | my ($operation, $jobs, $type) = @_; 1159 | $type ||= "job"; 1160 | return if $jenkins[0]->{yes}; 1161 | my ($in, $out) = $jenkins[0]->stdio; 1162 | while(1 && ! $opts{yes} ) { 1163 | print $out "Mutliple ${type}s found for pattern /$filter/\n"; 1164 | print $out " ", $_->name, "\n" for @$jobs; 1165 | print $out "Do you want to $operation all of them? [y/N]: "; 1166 | my $ans = <$in>; 1167 | chomp($ans); 1168 | if( !$ans || $ans =~ /^n/i ) { 1169 | exit; 1170 | } 1171 | if( $ans =~ /^y/i ) { 1172 | return; 1173 | } 1174 | print $out "Sorry, didn't understand \"$ans\"\n"; 1175 | } 1176 | } 1177 | 1178 | sub colorize { 1179 | my ( $color ) = shift; 1180 | # dont colorize when redirected to non-tty 1181 | return @_ unless -t STDOUT; 1182 | return color($color), @_, color("reset"); 1183 | } 1184 | --------------------------------------------------------------------------------