| 1 | my $sep = $^O eq "MSWin32" ? "\\" : "/";
|
|---|
| 2 |
|
|---|
| 3 | sub get_date {
|
|---|
| 4 | local ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
|
|---|
| 5 | local $day = $mday;
|
|---|
| 6 | local $month = $mon+1;
|
|---|
| 7 | local $year = $year+1900;
|
|---|
| 8 | if ( length $month == 1 ) {
|
|---|
| 9 | $month = join( "", "0", $month);
|
|---|
| 10 | }
|
|---|
| 11 | if ( length $day== 1 ) {
|
|---|
| 12 | $day = join( "", "0", $day );
|
|---|
| 13 | }
|
|---|
| 14 | local $date = join( ".", $year,$month,$day );
|
|---|
| 15 | return $date;
|
|---|
| 16 | }
|
|---|
| 17 |
|
|---|
| 18 | sub gen_snapshot_id {
|
|---|
| 19 | if ( exists $_[0] && exists $_[1] ) {
|
|---|
| 20 | return $_[0] . get_date() . $_[1];
|
|---|
| 21 | }
|
|---|
| 22 |
|
|---|
| 23 | if ( exists $_[0] ) {
|
|---|
| 24 | return $_[0] . get_date();
|
|---|
| 25 | }
|
|---|
| 26 | return get_date();
|
|---|
| 27 | }
|
|---|
| 28 |
|
|---|
| 29 | sub create_release {
|
|---|
| 30 |
|
|---|
| 31 | die "Must provide parameter to create_release\n" unless (exists $_[0]);
|
|---|
| 32 |
|
|---|
| 33 | my $release_folder_name = $_[0];
|
|---|
| 34 |
|
|---|
| 35 | my $release_version = $release_folder_name;
|
|---|
| 36 | $release_version =~ s/^gs-?//;
|
|---|
| 37 | $release_version =~ s/rc\d$//;
|
|---|
| 38 | my $major_version = $release_version;
|
|---|
| 39 | $major_version =~ s/^(3|2).*/$1/;
|
|---|
| 40 | $release_version =~ s/^($major_version)\.?(\d*).*/$1.$2/;
|
|---|
| 41 | my $rk = "rk".$major_version;
|
|---|
| 42 |
|
|---|
| 43 | my $release_version_extra;
|
|---|
| 44 | if ($release_folder_name =~ m/(rc\d)$/) {
|
|---|
| 45 | $release_version_extra = $1;
|
|---|
| 46 | }
|
|---|
| 47 | if ($release_folder_name !~ m/^gs/) { # prefix gs
|
|---|
| 48 | $release_folder_name = "gs".$release_folder_name;
|
|---|
| 49 | }
|
|---|
| 50 | my $release_dir = "$ENV{'DATA_DIR'}${sep}$release_folder_name";
|
|---|
| 51 |
|
|---|
| 52 | print "major_version: $major_version\n";
|
|---|
| 53 | print "version: $release_version\n";
|
|---|
| 54 | print "versionextra: $release_version_extra\n";
|
|---|
| 55 | print "release_folder_name: $release_folder_name\n";
|
|---|
| 56 | print "release_dir: $release_dir\n";
|
|---|
| 57 |
|
|---|
| 58 | print "about to clean up old snapshots (Ctrl-C to cancel)";
|
|---|
| 59 | local $| = 1;
|
|---|
| 60 | for ( my $i=0; $i<5; $i++ ) {
|
|---|
| 61 | print ".";
|
|---|
| 62 | sleep 1;
|
|---|
| 63 | }
|
|---|
| 64 | $| = 0;
|
|---|
| 65 |
|
|---|
| 66 | print "cleaning up previous release snapshot $release_dir\n";
|
|---|
| 67 |
|
|---|
| 68 | if(-d $release_dir) {
|
|---|
| 69 | if ( $^O eq "MSWin32" ) {
|
|---|
| 70 | system("rd /q /s \"$release_dir\"");
|
|---|
| 71 | } else {
|
|---|
| 72 | system("rm -rf \"$release_dir\"");
|
|---|
| 73 | }
|
|---|
| 74 | }
|
|---|
| 75 |
|
|---|
| 76 | print "creating the release dir\n";
|
|---|
| 77 | mkdir $release_dir or die "couldn't create release directory\n";
|
|---|
| 78 |
|
|---|
| 79 | print "changing to the release dir\n";
|
|---|
| 80 | chdir $release_dir;
|
|---|
| 81 |
|
|---|
| 82 | #version property
|
|---|
| 83 | print "setting up todays properties\n";
|
|---|
| 84 | `echo version:$release_version> $rk-build.properties`;
|
|---|
| 85 |
|
|---|
| 86 | if($release_version_extra) {
|
|---|
| 87 | `echo version-extra:$release_version_extra>> $rk-build.properties`;
|
|---|
| 88 | }
|
|---|
| 89 |
|
|---|
| 90 | #processor propertylocal $| = 1;
|
|---|
| 91 | if ( $^O eq "darwin" ) {
|
|---|
| 92 | print "setting processor\n";
|
|---|
| 93 | if ( `uname -p` eq "i386" ) {
|
|---|
| 94 | `echo processor:intel>> $rk-build.properties`;
|
|---|
| 95 | } elsif ( `uname -p` eq "powerpc" ) {
|
|---|
| 96 | `echo processor:ppc>> $rk-build.properties`;
|
|---|
| 97 | } else {
|
|---|
| 98 | print "unable to determine processor type, using intel\n";
|
|---|
| 99 | `echo processor:intel>> $rk-build.properties`;
|
|---|
| 100 | }
|
|---|
| 101 | } elsif ( $^O eq "linux" ) {
|
|---|
| 102 | # Running "uname -m" on new 32 bit VM returns "i86_64" too
|
|---|
| 103 | # So to properly test for 32 bit, ensure that environment.pl
|
|---|
| 104 | # didn't set $ENV{'GS_OPENSSL_HOST'} to "linux-generic32"
|
|---|
| 105 | if(`uname -m` =~ m/64$/) {
|
|---|
| 106 | if(! exists $ENV{'GS_OPENSSL_HOST'} || $ENV{'GS_OPENSSL_HOST'} ne "linux-generic32") {
|
|---|
| 107 | print "Setting linux architecture to 64 bit";
|
|---|
| 108 | `echo x64:true>> $rk-build.properties`;
|
|---|
| 109 | }
|
|---|
| 110 | }
|
|---|
| 111 | }
|
|---|
| 112 |
|
|---|
| 113 | #branch path property
|
|---|
| 114 | if ( $ENV{'branch_path'} ) {
|
|---|
| 115 | `echo branch.path:$ENV{'branch_path'}>> $rk-build.properties`;
|
|---|
| 116 | }
|
|---|
| 117 |
|
|---|
| 118 | #server.exe.location
|
|---|
| 119 | if ( $major_version eq "2" && exists $ENV{'SERVER_EXE_LOCATION'} ) {
|
|---|
| 120 | `echo server.exe.location:$ENV{'SERVER_EXE_LOCATION'}>> $rk-build.properties`;
|
|---|
| 121 | }
|
|---|
| 122 |
|
|---|
| 123 | print "creating the snapshot using $rk\n";
|
|---|
| 124 | system( $rk );
|
|---|
| 125 | }
|
|---|
| 126 |
|
|---|
| 127 | sub create {
|
|---|
| 128 |
|
|---|
| 129 | die "release_dir not set, cant create\n" unless $release_dir;
|
|---|
| 130 |
|
|---|
| 131 | print "about to clean up old snapshots (Ctrl-C to cancel)";
|
|---|
| 132 | local $| = 1;
|
|---|
| 133 | for ( my $i=0; $i<5; $i++ ) {
|
|---|
| 134 | print ".";
|
|---|
| 135 | sleep 1;
|
|---|
| 136 | }
|
|---|
| 137 | $| = 0;
|
|---|
| 138 |
|
|---|
| 139 | print "cleaning up previous snapshot\n";
|
|---|
| 140 | local $release_parent = dirname($release_dir);
|
|---|
| 141 | if ( $^O eq "MSWin32" ) {
|
|---|
| 142 | system("rd /q /s \"$release_parent\"");
|
|---|
| 143 | } else {
|
|---|
| 144 | system("rm -rf \"$release_parent\"");
|
|---|
| 145 | }
|
|---|
| 146 |
|
|---|
| 147 | print "creating the release dir\n";
|
|---|
| 148 | mkdir $release_parent or die "couldn't create release parent directory\n";
|
|---|
| 149 | mkdir $release_dir or die "couldn't create release directory\n";
|
|---|
| 150 |
|
|---|
| 151 | print "changing to the release dir\n";
|
|---|
| 152 | chdir $release_dir;
|
|---|
| 153 |
|
|---|
| 154 | #version property
|
|---|
| 155 | print "setting up todays properties\n";
|
|---|
| 156 | `echo version:$snapshot_id> $rk-build.properties`;
|
|---|
| 157 |
|
|---|
| 158 | #processor propertylocal $| = 1;
|
|---|
| 159 | if ( $^O eq "darwin" ) {
|
|---|
| 160 | print "setting processor\n";
|
|---|
| 161 | if ( `uname -p` eq "i386" ) {
|
|---|
| 162 | `echo processor:intel>> $rk-build.properties`;
|
|---|
| 163 | } elsif ( `uname -p` eq "powerpc" ) {
|
|---|
| 164 | `echo processor:ppc>> $rk-build.properties`;
|
|---|
| 165 | } else {
|
|---|
| 166 | print "unable to determine processor type, using intel\n";
|
|---|
| 167 | `echo processor:intel>> $rk-build.properties`;
|
|---|
| 168 | }
|
|---|
| 169 | }
|
|---|
| 170 |
|
|---|
| 171 | #branch path property
|
|---|
| 172 | if ( $ENV{'branch_path'} ) {
|
|---|
| 173 | `echo branch.path:$ENV{'branch_path'}>> $rk-build.properties`;
|
|---|
| 174 | }
|
|---|
| 175 |
|
|---|
| 176 | #server.exe.location
|
|---|
| 177 | if ( exists $ENV{'SERVER_EXE_LOCATION'} ) {
|
|---|
| 178 | `echo server.exe.location:$ENV{'SERVER_EXE_LOCATION'}>> $rk-build.properties`;
|
|---|
| 179 | }
|
|---|
| 180 |
|
|---|
| 181 | print "creating the snapshot using $rk\n";
|
|---|
| 182 | system( $rk );
|
|---|
| 183 |
|
|---|
| 184 | }
|
|---|
| 185 |
|
|---|
| 186 | sub upload {
|
|---|
| 187 | print "preparing files for uploading\n";
|
|---|
| 188 |
|
|---|
| 189 | my @munges = ();
|
|---|
| 190 | if ( exists $ENV{'munges'} ) {
|
|---|
| 191 | @munges = split(' ', $ENV{'munges'});
|
|---|
| 192 | }
|
|---|
| 193 |
|
|---|
| 194 | #copy products to a temporary folder, giving them their new names
|
|---|
| 195 | if ( -d "$release_dir${sep}uploads" ) {
|
|---|
| 196 | system( "rm -rf '$release_dir${sep}uploads'" );
|
|---|
| 197 | }
|
|---|
| 198 | mkdir "$release_dir${sep}uploads";
|
|---|
| 199 |
|
|---|
| 200 | my @files;
|
|---|
| 201 | if ( -d "$release_dir${sep}products" ) {
|
|---|
| 202 | @files = <$release_dir${sep}products${sep}*>;
|
|---|
| 203 | }
|
|---|
| 204 | push( @files, "$release_dir${sep}$rk.out" );
|
|---|
| 205 |
|
|---|
| 206 | for my $file ( @files ) {
|
|---|
| 207 | if ( -e $file ) {
|
|---|
| 208 | my $filename = basename($file);
|
|---|
| 209 | #munge
|
|---|
| 210 | for my $m ( @munges ) {
|
|---|
| 211 | $doit="\$filename =~ $m"; eval "$doit";
|
|---|
| 212 | }
|
|---|
| 213 | # copy to uploads folder
|
|---|
| 214 | print "Copying '" . basename($file) . "' to '$filename' in uploads folder\n";
|
|---|
| 215 | if( $^O =~ "linux|darwin" ) {
|
|---|
| 216 | system("cp \"$file\" \"${release_dir}${sep}uploads${sep}$filename\"");
|
|---|
| 217 | }
|
|---|
| 218 | else {
|
|---|
| 219 | system("copy \"$file\" \"${release_dir}${sep}uploads${sep}$filename\"");
|
|---|
| 220 | }
|
|---|
| 221 | }
|
|---|
| 222 |
|
|---|
| 223 | }
|
|---|
| 224 |
|
|---|
| 225 | # ssh too old inside lsb to upload to www-internal, so we do that in a separate step later
|
|---|
| 226 | # We use the upload-files-to-www-internal.sh script on linux systems now
|
|---|
| 227 | # The following is still left in as it appears to work for the mac
|
|---|
| 228 |
|
|---|
| 229 | if( $^O !~ "linux" ) {
|
|---|
| 230 | my $command = "";
|
|---|
| 231 |
|
|---|
| 232 | ##my $out = `set`;
|
|---|
| 233 | ##print "out = $out\n";
|
|---|
| 234 | #$command = "cd \"${release_dir}${sep}uploads\" && tar -c * | ";
|
|---|
| 235 | #$command .= ($^O eq "MSWin32" ? "plink" : "ssh");
|
|---|
| 236 | #$command .= " -T -i \"$ENV{'IDENTITY_FILE'}\" nzdl\@puka.cs.waikato.ac.nz";
|
|---|
| 237 | #print "$command\n";
|
|---|
| 238 | #system("$command");
|
|---|
| 239 |
|
|---|
| 240 | ## for now, upload a copy to the new machine, later to replace puka
|
|---|
| 241 | #$command = "cd \"${release_dir}${sep}uploads\" && tar -c * | ";
|
|---|
| 242 | #$command .= ($^O eq "MSWin32" ? "plink" : "ssh");
|
|---|
| 243 | #$command .= " -T -i \"$ENV{'IDENTITY_FILE'}\" nzdl-gsorg\@wwwdev.greenstone.org";
|
|---|
| 244 | ##print "$command\n";
|
|---|
| 245 | #system("$command");
|
|---|
| 246 |
|
|---|
| 247 | # also upload a copy to www-internal, which is the new wwwdev, and will replace puka.
|
|---|
| 248 | $command = "cd \"${release_dir}${sep}uploads\" && tar -c * | ";
|
|---|
| 249 | $command .= ($^O eq "MSWin32" ? "plink" : "ssh");
|
|---|
| 250 | $command .= " -T -i \"$ENV{'IDENTITY_FILE_ED25519'}\" nzdl-gsorg\@www-internal.greenstone.org";
|
|---|
| 251 | print "$command\n";
|
|---|
| 252 | system("$command");
|
|---|
| 253 | }
|
|---|
| 254 | }
|
|---|
| 255 |
|
|---|
| 256 | # EMAILING DOESN'T WORK, as SMTP not setup on release-kit LSB machines
|
|---|
| 257 |
|
|---|
| 258 | #sub xsend_mail_on_releasekit_fail {
|
|---|
| 259 |
|
|---|
| 260 | # first, create your message
|
|---|
| 261 | # use Email::MIME;
|
|---|
| 262 | # my $message = Email::MIME->create(
|
|---|
| 263 | # header_str => [
|
|---|
| 264 | # From => $ENV{'MONITOR_EMAIL'},
|
|---|
| 265 | # To => $ENV{'MONITOR_EMAIL'},
|
|---|
| 266 | # Subject => 'Trial message',
|
|---|
| 267 | # ],
|
|---|
| 268 | # attributes => {
|
|---|
| 269 | # encoding => 'quoted-printable',
|
|---|
| 270 | # charset => 'ISO-8859-1',
|
|---|
| 271 | # },
|
|---|
| 272 | # body_str => "Email test!\n",
|
|---|
| 273 | # );
|
|---|
| 274 |
|
|---|
| 275 | # # send the message
|
|---|
| 276 | # use Email::Sender::Simple qw(sendmail);
|
|---|
| 277 | # sendmail($message);
|
|---|
| 278 |
|
|---|
| 279 | # %mail = ( To => $ENV{'MONITOR_EMAIL'},
|
|---|
| 280 | # From => $ENV{'MONITOR_EMAIL'},
|
|---|
| 281 | # Message => "This is a test message"
|
|---|
| 282 | # );
|
|---|
| 283 |
|
|---|
| 284 | # sendmail(%mail) or die $Mail::Sendmail::error;
|
|---|
| 285 |
|
|---|
| 286 | # print "OK. Log says:\n", $Mail::Sendmail::log;
|
|---|
| 287 | #}
|
|---|
| 288 |
|
|---|
| 289 | # EMAILING DOESN'T WORK, as SMTP not setup on release-kit LSB machines
|
|---|
| 290 |
|
|---|
| 291 | # Copied from diffcol's task.pl into here
|
|---|
| 292 | # Sending emails with perl: http://learn.perl.org/examples/email.html
|
|---|
| 293 | # Sending email attachments with perl: http://www.perlmonks.org/?node_id=19430
|
|---|
| 294 | # Sadly none of the packages are installed by default and use of MIME::Lite is discouraged
|
|---|
| 295 | sub send_mail_on_releasekit_fail
|
|---|
| 296 | {
|
|---|
| 297 | # email greenstone_team if build failed
|
|---|
| 298 |
|
|---|
| 299 | my $logfile="$release_dir${sep}$rk.out";
|
|---|
| 300 | my $finalLinesLogOutput=`tail -n 50 $logfile`;
|
|---|
| 301 |
|
|---|
| 302 | print STDERR "Checking if successful... \n";
|
|---|
| 303 | # using reverse index to search from bottom of tail output
|
|---|
| 304 | my $had_error = 0;
|
|---|
| 305 |
|
|---|
| 306 | if (rindex($finalLinesLogOutput, "BUILD FAILED") != -1) {
|
|---|
| 307 | # release-kit failed to build binary
|
|---|
| 308 | $had_error = 1;
|
|---|
| 309 | }
|
|---|
| 310 | elsif (rindex($finalLinesLogOutput, "BUILD SUCCESSFUL") != -1) {
|
|---|
| 311 | # SUCCESS!
|
|---|
| 312 | $had_error = 0;
|
|---|
| 313 | }
|
|---|
| 314 | else {
|
|---|
| 315 | # saw neither BUILD FAILED nor BUILD SUCCESSFUL in tail of log output
|
|---|
| 316 | # Could be that building never completed, still want to be notified
|
|---|
| 317 | $had_error = 2;
|
|---|
| 318 | }
|
|---|
| 319 |
|
|---|
| 320 |
|
|---|
| 321 | if(!$had_error) {
|
|---|
| 322 | # everything fine, no need to email
|
|---|
| 323 | return;
|
|---|
| 324 | }
|
|---|
| 325 |
|
|---|
| 326 |
|
|---|
| 327 | print STDERR "Build had error code: $had_error\n";
|
|---|
| 328 | # let's send the last 200 lines of the log file to the user as email
|
|---|
| 329 | #
|
|---|
| 330 | $finalLinesLogOutput=`tail -n 200 $logfile`;
|
|---|
| 331 |
|
|---|
| 332 | my $msg = "Last 200 lines in the log:\n$finalLinesLogOutput";
|
|---|
| 333 | my $subject = "Release-kit $release_dir failed"; # mentions OS, bitness, date
|
|---|
| 334 |
|
|---|
| 335 | # let's attach logfile besides
|
|---|
| 336 |
|
|---|
| 337 | if($isWin) {
|
|---|
| 338 | if($use_blat && $blat && $ENV{'GSDL_SMTP'}) {
|
|---|
| 339 | # http://stackoverflow.com/questions/709635/sending-mail-from-batch-file
|
|---|
| 340 | #blat -to [email protected] -server smtp.example.com -f [email protected] -subject "subject" -body "body"
|
|---|
| 341 |
|
|---|
| 342 | # need to install blat on windows
|
|---|
| 343 | $cmd = "$blat -to $ENV{'MONITOR_EMAIL'} -server $ENV{'GSDL_SMTP'} -f $ENV{'MONITOR_EMAIL'} -attach $logfile -subject \"$subject\" -body \"$msg\"";
|
|---|
| 344 | $result = system($cmd);
|
|---|
| 345 | }
|
|---|
| 346 | else {
|
|---|
| 347 | $result = 1; # status from running mail command is 0 if success, 1 if fail
|
|---|
| 348 | print STDERR "********************************************\n";
|
|---|
| 349 | if ($use_blat) {
|
|---|
| 350 | print STDERR "Need blat and SMTP set to send mail attachment\n" ;
|
|---|
| 351 | } else {
|
|---|
| 352 | print STDERR "Not set up to send mail on Windows\n";
|
|---|
| 353 | }
|
|---|
| 354 | print STDERR "Inspect release-kit build log at: $log_file\n";
|
|---|
| 355 | print STDERR "********************************************\n";
|
|---|
| 356 | }
|
|---|
| 357 | } else { # linux
|
|---|
| 358 |
|
|---|
| 359 | # try using sendmail, since mutt is not installed on lsb
|
|---|
| 360 | # https://vitux.com/three-ways-to-send-email-from-ubuntu-command-line/
|
|---|
| 361 | # Sending attachment with sendmail is too involved, see
|
|---|
| 362 | # https://unix.stackexchange.com/questions/223636/sendmail-attachment/223650
|
|---|
| 363 | # https://askubuntu.com/questions/355823/sending-file-using-sendmail
|
|---|
| 364 | # Will just put the contents of the rk log file in the body.
|
|---|
| 365 |
|
|---|
| 366 | # read in all of logfile
|
|---|
| 367 | # https://stackoverflow.com/questions/206661/what-is-the-best-way-to-slurp-a-file-into-a-string-in-perl
|
|---|
| 368 | my $contents = do {local (@ARGV,$/) = $logfile; <>};
|
|---|
| 369 | my $email_path = "$release_dir${sep}email.txt";
|
|---|
| 370 | if (open(FOUT, '>:utf8', $email_path))
|
|---|
| 371 | {
|
|---|
| 372 | print FOUT "Subject: $subject";
|
|---|
| 373 | if($contents) {
|
|---|
| 374 | print FOUT $contents;
|
|---|
| 375 | } else {
|
|---|
| 376 | print FOUT "Empty release kit building log: $logfile\n";
|
|---|
| 377 | }
|
|---|
| 378 | close(FOUT);
|
|---|
| 379 | $cmd = "sendmail $ENV{'MONITOR_EMAIL'} < $email_path";
|
|---|
| 380 | $result = system($cmd);
|
|---|
| 381 | }
|
|---|
| 382 | else
|
|---|
| 383 | {
|
|---|
| 384 | print STDERR "WARNING: sendmail email attempt failed. Failed to open file for writing email msg:\n\t$email_path\n";
|
|---|
| 385 |
|
|---|
| 386 | # try using mutt to send email
|
|---|
| 387 | my $status = system("command -v mutt > /dev/null 2>&1;"); #better way of doing "which mutt"
|
|---|
| 388 |
|
|---|
| 389 | if($status != 0) { # mutt doesn't exist, can't send attachments, so send simple email
|
|---|
| 390 | $cmd="echo '$message' | mail -s '$subject' $ENV{'MONITOR_EMAIL'}";
|
|---|
| 391 |
|
|---|
| 392 | print STDERR "********************************************\n";
|
|---|
| 393 | print STDERR "No mutt installed, unable to mail attachment\n";
|
|---|
| 394 | print STDERR "Inspect release-kit build log at: $logfile\n";
|
|---|
| 395 | print STDERR "********************************************\n";
|
|---|
| 396 | } else {
|
|---|
| 397 | #$cmd = "bash -c \"echo '$message' | mutt -a $logfile -s 'subject' -- $ENV{'MONITOR_EMAIL'}\"";
|
|---|
| 398 | $cmd = "echo '$message' | mutt -a $logfile -s '$subject' -- $ENV{'MONITOR_EMAIL'}";
|
|---|
| 399 | }
|
|---|
| 400 |
|
|---|
| 401 | # run the mail command
|
|---|
| 402 | $result = system($cmd); #&run_and_print_cmd($cmd);
|
|---|
| 403 | }
|
|---|
| 404 | }
|
|---|
| 405 |
|
|---|
| 406 |
|
|---|
| 407 | if($result != 0) {
|
|---|
| 408 | print STDERR "*** Unable to send email: $?\n";
|
|---|
| 409 | }
|
|---|
| 410 | else {
|
|---|
| 411 | print STDERR "Sent mail with $logfile attached.\n";
|
|---|
| 412 | }
|
|---|
| 413 |
|
|---|
| 414 | }
|
|---|
