1#!/usr/bin/expect 2# 3# Copyright (C) 2010 Free Software Foundation, Inc. 4# 5# This program is free software; you can redistribute it and/or modify 6# it under the terms of the GNU General Public License as published by 7# the Free Software Foundation; either version 3 of the License, or 8# (at your option) any later version. 9# 10# This program is distributed in the hope that it will be useful, 11# but WITHOUT ANY WARRANTY; without even the implied warranty of 12# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13# GNU General Public License for more details. 14# You should have received a copy of the GNU General Public License 15# along with this program; if not, write to the Free Software 16# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 17# 18 19if {![info exists argv0]} { 20 send_error "Must use a version of Expect greater than 5.0\n" 21 exit 1 22} 23 24# 25# Global variables used by all files. 26# 27set logname "" ;# the users login name 28set configopts "" ;# options to pass to configure 29set branch "trunk" ;# the bzr branch to build 30set revno "" ;# the bzr revno to build 31set make "make" ;# make program, sometimes gmake 32set makeopts "-w" ;# options to pass to make 33set uploadcmd "dupload" ;# program to upload packages 34set objdir "/build/trunk" ;# the base build tree 35set srcdir "/build/src/trunk" ;# the base source tree 36set inp "" 37set outp "" 38set timeout "" 39set verbose 0 40set sumfile "" 41set tool "" 42set state "bzr" 43# 44# These describe the host and target environments. 45# 46set build_triplet "" ;# type of architecture to run tests on 47set build_os "" ;# type of os the tests are running on 48set build_vendor "" ;# vendor name of the OS or workstation the test are running on 49set build_cpu "" ;# type of the cpu tests are running on 50set host_triplet "" ;# type of architecture to run tests on, sometimes remotely 51set host_os "" ;# type of os the tests are running on 52set host_vendor "" ;# vendor name of the OS or workstation the test are running on 53set host_cpu "" ;# type of the cpu tests are running on 54set target_triplet "" ;# type of architecture to run tests on, final remote 55set target_os "" ;# type of os the tests are running on 56set target_vendor "" ;# vendor name of the OS or workstation the test are running on 57set target_cpu "" ;# type of the cpu tests are running on 58set target_alias "" ;# standard abbreviation of target 59set compiler_flags "" ;# the flags used by the compiler 60set only "no" ;# only run one state at a time 61 62# 63# trap some signals so we know whats happening. These definitions are only 64# temporary until we read in the library stuff 65# 66trap { send_user "\nterminated\n"; exit 1 } SIGTERM 67trap { send_user "\ninterrupted by user\n"; exit 1 } SIGINT 68trap { send_user "\nsigquit\n"; exit 1 } SIGQUIT 69 70# 71# some convenience abbreviations 72# 73if {![info exists hex]} { 74 set hex "0x\[0-9A-Fa-f\]+" 75} 76if {![info exists decimal]} { 77 set decimal "\[0-9\]+" 78} 79 80 81# 82# set the base dir (current working directory) 83# 84set base_dir [pwd] 85 86# 87# verbose [-n] [-log] [--] message [level] 88# 89# Print MESSAGE if the verbose level is >= LEVEL. 90# The default value of LEVEL is 1. 91# "-n" says to not print a trailing newline. 92# "-log" says to add the text to the log file even if it won't be printed. 93# Note that the apparent behaviour of `send_user' dictates that if the message 94# is printed it is also added to the log file. 95# Use "--" if MESSAGE begins with "-". 96# 97# This is defined here rather than in framework.exp so we can use it 98# while still loading in the support files. 99# 100proc verbose { args } { 101 global verbose 102 set newline 1 103 set logfile 0 104 105 set i 0 106 if { [string index [lindex $args 0] 0] == "-" } { 107 for { set i 0 } { $i < [llength $args] } { incr i } { 108 if { [lindex $args $i] == "--" } { 109 incr i 110 break 111 } elseif { [lindex $args $i] == "-n" } { 112 set newline 0 113 } elseif { [lindex $args $i] == "-log" } { 114 set logfile 1 115 } elseif { [lindex $args $i] == "-x" } { 116 set xml 1 117 } elseif { [string index [lindex $args $i] 0] == "-" } { 118 clone_output "ERROR: verbose: illegal argument: [lindex $args $i]" 119 return 120 } else { 121 break 122 } 123 } 124 if { [llength $args] == $i } { 125 clone_output "ERROR: verbose: nothing to print" 126 return 127 } 128 } 129 130 set level 1 131 if { [llength $args] > $i + 1 } { 132 set level [lindex $args [expr { $i + 1 }]] 133 } 134 set message [lindex $args $i] 135 136 if { $verbose >= $level } { 137 # There is no need for the "--" argument here, but play it safe. 138 # We assume send_user also sends the text to the log file (which 139 # appears to be the case though the docs aren't clear on this). 140 if { $newline } { 141 send_user -- "$message\n" 142 } else { 143 send_user -- "$message" 144 } 145 } elseif { $logfile } { 146 if { $newline } { 147 send_log "$message\n" 148 } else { 149 send_log "$message" 150 } 151 } 152} 153# 154# load_file [-1] [--] file1 [ file2 ... ] 155# 156# Utility to source a file. All are sourced in order unless the flag "-1" 157# is given in which case we stop after finding the first one. 158# The result is 1 if a file was found, 0 if not. 159# If a tcl error occurs while sourcing a file, we print an error message 160# and exit. 161# 162# ??? Perhaps add an optional argument of some descriptive text to add to 163# verbose and error messages (eg: -t "library file" ?). 164# 165proc load_file { args } { 166 set i 0 167 set only_one 0 168 if { [lindex $args $i] == "-1" } { 169 set only_one 1 170 incr i 171 } 172 if { [lindex $args $i] == "--" } { 173 incr i 174 } 175 176 set found 0 177 foreach file [lrange $args $i end] { 178 verbose "Looking for $file" 2 179 # In Tcl7.5a2, "file exists" can fail if the filename looks 180 # like ~/FILE and the environment variable HOME does not 181 # exist. 182 if {! [catch {file exists $file} result] && $result} { 183 set found 1 184 verbose "Found $file" 185 if { [catch "uplevel #0 source $file"] == 1 } { 186 send_error "ERROR: tcl error sourcing $file.\n" 187 global errorInfo 188 if {[info exists errorInfo]} { 189 send_error "$errorInfo\n" 190 } 191 exit 1 192 } 193 if { $only_one } { 194 break 195 } 196 } 197 } 198 return $found 199} 200 201# 202# search_and_load_file -- search DIRLIST looking for FILELIST. 203# TYPE is used when displaying error and progress messages. 204# 205proc search_and_load_file { type filelist dirlist } { 206 set found 0 207 208 foreach dir $dirlist { 209 foreach initfile $filelist { 210 verbose "Looking for $type ${dir}/${initfile}" 2 211 if {[file exists [file join ${dir} ${initfile}]]} { 212 set found 1 213 set error "" 214 if { ${type} != "library file" } { 215 send_user "Using ${dir}/${initfile} as ${type}.\n" 216 } else { 217 verbose "Loading ${dir}/${initfile}" 218 } 219 if {[catch "uplevel #0 source ${dir}/${initfile}" error] == 1} { 220 global errorInfo 221 send_error "ERROR: tcl error sourcing ${type} ${dir}/${initfile}.\n${error}\n" 222 if {[info exists errorInfo]} { 223 send_error "$errorInfo\n" 224 } 225 exit 1 226 } 227 break 228 } 229 } 230 if { $found } { 231 break 232 } 233 } 234 return $found 235} 236 237# 238# Give a usage statement. 239# 240proc usage { } { 241 global tool 242 243 send_user "USAGE: buildhost \[options...\]\n" 244 send_user "\t (--st) (-state)\t\tset the state manually\n" 245 send_user "\t (--on) (-only)\t\tonly run the one state\n" 246 send_user "\tstates are: bzr autogen configure make dpkg upload test clean" 247} 248 249# 250# Parse the arguments the first time looking for these. We will ultimately 251# parse them twice. Things are complicated because: 252# - we want to parse --verbose early on 253# - we don't want config files to override command line arguments 254# (eg: $base_dir/$configfile vs --host/--target) 255# - we need some command line arguments before we can process some config files 256# (eg: --objdir before $objdir/$configfile, --host/--target before $DEJAGNU) 257# The use of `arg_host_triplet' and `arg_target_triplet' lets us avoid parsing 258# the arguments three times. 259# 260 261set arg_host_triplet "" 262set arg_target_triplet "" 263set arg_build_triplet "" 264set argc [ llength $argv ] 265for { set i 0 } { $i < $argc } { incr i } { 266 set option [lindex $argv $i] 267 268 # make all options have two hyphens 269 switch -glob -- $option { 270 "--*" { 271 } 272 "-*" { 273 set option "-$option" 274 } 275 } 276 277 # split out the argument for options that take them 278 switch -glob -- $option { 279 "--*=*" { 280 regexp {^[^=]*=(.*)$} $option nil optarg 281 } 282 "--on*" - 283 "--ob*" - 284 "--sr*" - 285 "--st*" { 286 incr i 287 set optarg [lindex $argv $i] 288 } 289 } 290 291 switch -glob -- $option { 292 "--ob*" { # (--objdir) where the test case object code lives 293 set objdir $optarg 294 continue 295 } 296 297 "--sr*" { # (--srcdir) where the source code lives 298 set srcdir $optarg 299 continue 300 } 301 302 "--st*" { # (--state) the initial state 303 set state $optarg 304 continue 305 } 306 307 "--on*" { # (--only) only run one state, then exit 308 set only yes 309 continue 310 } 311 312 "--v" - 313 "--verb*" { # (--verbose) verbose output 314 incr verbose 315 continue 316 } 317 318 "[A-Z0-9_-.]*=*" { # process makefile style args like CC=gcc, etc... 319 if {[regexp "^(\[A-Z0-9_-\]+)=(.*)$" $option junk var val]} { 320 set $var $val 321 verbose "$var is now $val" 322 append makevars "set $var $val;" ;# FIXME: Used anywhere? 323 unset junk var val 324 } else { 325 send_error "Illegal variable specification:\n" 326 send_error "$option\n" 327 } 328 continue 329 } 330 331 } 332} 333 334verbose "Verbose level is $verbose" 335 336# 337# get the users login name 338# 339if {[string match "" $logname]} { 340 if {[info exists env(USER)]} { 341 set logname $env(USER) 342 } else { 343 if {[info exists env(LOGNAME)]} { 344 set logname $env(LOGNAME) 345 } else { 346 # try getting it with whoami 347 catch "set logname [exec whoami]" tmp 348 if {[string match "*couldn't find*to execute*" $tmp]} { 349 # try getting it with who am i 350 unset tmp 351 catch "set logname [exec who am i]" tmp 352 if {[string match "*Command not found*" $tmp]} { 353 send_user "ERROR: couldn't get the users login name\n" 354 set logname "Unknown" 355 } else { 356 set logname [lindex [split $logname " !"] 1] 357 } 358 } 359 } 360 } 361} 362 363# 364# lookfor_file -- try to find a file by searching up multiple directory levels 365# 366proc lookfor_file { dir name } { 367 foreach x ".. ../.. ../../.. ../../../.." { 368 verbose "$dir/$name" 2 369 if {[file exists [file join $dir $name]]} { 370 return [file join $dir $name] 371 } 372 set dir [remote_file build dirname $dir] 373 } 374 return "" 375} 376 377# 378# load_lib -- load a library by sourcing it 379# 380# If there a multiple files with the same name, stop after the first one found. 381# The order is first look in the install dir, then in a parallel dir in the 382# source tree, (up one or two levels), then in the current dir. 383# 384proc load_lib { file } { 385 global verbose libdir srcdir base_dir execpath tool 386 global loaded_libs 387 388 if {[info exists loaded_libs($file)]} { 389 return 390 } 391 392 set loaded_libs($file) "" 393 394 if { [search_and_load_file "library file" $file [list ../lib $libdir $libdir/lib [file dirname [file dirname $srcdir]]/dejagnu/lib $srcdir/lib $execpath/lib . [file dirname [file dirname [file dirname $srcdir]]]/dejagnu/lib]] == 0 } { 395 send_error "ERROR: Couldn't find library file $file.\n" 396 exit 1 397 } 398} 399 400# local_hostname - get the local hostname 401proc get_local_hostname { } { 402 if {[catch "info hostname" hb]} { 403 set hb "" 404 } else { 405 regsub "\\..*$" $hb "" hb 406 } 407 verbose "hostname=$hb" 3 408 return $hb 409} 410 411verbose "Login name on [get_local_hostname] is $logname" 412 413# 414# parse out the config parts of the triplet name 415# 416 417# build values 418if { $build_cpu == "" } { 419 regsub -- "-.*-.*" ${build_triplet} "" build_cpu 420} 421if { $build_vendor == "" } { 422 regsub -- "^\[a-z0-9\]*-" ${build_triplet} "" build_vendor 423 regsub -- "-.*" ${build_vendor} "" build_vendor 424} 425if { $build_os == "" } { 426 regsub -- ".*-.*-" ${build_triplet} "" build_os 427} 428 429# host values 430if { $host_cpu == "" } { 431 regsub -- "-.*-.*" ${host_triplet} "" host_cpu 432} 433if { $host_vendor == "" } { 434 regsub -- "^\[a-z0-9\]*-" ${host_triplet} "" host_vendor 435 regsub -- "-.*" ${host_vendor} "" host_vendor 436} 437if { $host_os == "" } { 438 regsub -- ".*-.*-" ${host_triplet} "" host_os 439} 440 441# target values 442if { $target_cpu == "" } { 443 regsub -- "-.*-.*" ${target_triplet} "" target_cpu 444} 445if { $target_vendor == "" } { 446 regsub -- "^\[a-z0-9\]*-" ${target_triplet} "" target_vendor 447 regsub -- "-.*" ${target_vendor} "" target_vendor 448} 449if { $target_os == "" } { 450 regsub -- ".*-.*-" ${target_triplet} "" target_os 451} 452 453# 454# Load some of the DejaGnu libraries, so we can use the configure 455# and build procedures ourselves. Most of the time, these files 456# live in /usr or /usr/local. 457# 458if {[file exists "/usr/share/dejagnu"]} { 459 set libdir "/usr/share/dejagnu" 460} else { 461 set libdir "/usr/local/share/dejagnu" 462} 463set execpath [file dirname $argv0] 464if {[info exists env(DEJAGNULIBS)]} { 465 set libdir $env(DEJAGNULIBS) 466} 467load_lib framework.exp 468load_lib utils.exp 469load_lib target.exp 470load_lib remote.exp 471 472# set an output file name for commands 473# set outp "|& cat" 474# set outp "> /tmp/foo" 475 476set sumfile /tmp/sum 477set sum [open $sumfile w] 478 479# print an entry to the summary file 480proc sumfile { msg } { 481 global sum 482 puts $sum $msg 483} 484 485# print an informational entry to the summary file 486proc suminfo { msg } { 487 global inp outp timeout srcdir sum 488 set whoami [exec whoami] 489 set date [exec date] 490 #set logname [exec 'grep $whoami /etc/passwd | cut -d ":" -f 5'] 491 set ret [local_exec "uname --kernel-name --kernel-release" $inp $outp $timeout] 492 set status [lindex $ret 0] 493 set output [lindex $ret 1] 494 puts $sum "$msg: $date" 495 set rpm_opts [getenv RPM_BUILD_OPTIONS] 496 if {[string length $rpm_opts] > 0} { 497 puts $sum "RPM_BUILD_OPTIONS: $rpm_opts" 498 } 499 set deb_opts [getenv DEB_BUILD_OPTIONS] 500 if {[string length $deb_opts] > 0} { 501 puts $sum "DEB_BUILD_OPTIONS: $deb_opts" 502 } 503# puts $sum "$whoami" 504 puts $sum "$output" 505} 506 507# print a Start entry to the summary file 508proc procstart { msg } { 509 global sum 510 puts $sum "+ $msg: Started" 511} 512 513# print a Start entry to the summary file 514proc procdone { msg } { 515 global sum 516 puts $sum "- $msg: Done" 517} 518 519# update the source tree. This assume you already have it checked out. 520proc changedir { dir } { 521 cd $dir 522 verbose "Changed to directory: [pwd]" 523} 524 525# update the source tree. This assumes you already have it checked out 526# in the desired directory. 527proc bzr_update {} { 528 global inp outp timeout objdir srcdir 529 changedir $srcdir 530 procstart "Bzr" 531 set ret [local_exec "bzr pull" $inp $outp $timeout] 532 set status [lindex $ret 0] 533 set output [lindex $ret 1] 534 # if we couldn't update the sources, then we can't proceed 535 if {$status != 0} { 536 perror "bzr pull failed! " $output 537 exit 1 538 } 539 procdone "Bzr" 540 return $output 541} 542 543# extract the revision number 544proc bzr_revno {} { 545 global inp outp timeout objdir 546 changedir $objdir 547 set ret [local_exec "grep REVNO revno.h" $inp $outp $timeout] 548 set status [lindex $ret 0] 549 set output [lindex $ret 1] 550 551 # 552 set revno "" 553 regsub ".* = " $output "" revno 554 set revno [string trim $revno] 555 set revno [string trim $revno "\;\n\""] 556 557 # if we couldn't update the sources, then we can't proceed 558 if {$status != 0} { 559 perror "bzr revno failed! " $output 560 } 561 return $revno 562} 563 564# extract the branch nickname 565proc bzr_branch {} { 566 global inp outp timeout verbose srcdir objdir 567 changedir $objdir 568 set ret [local_exec "grep NICK revno.h" $inp $outp $timeout] 569 incr verbose 570 set status [lindex $ret 0] 571 set output [lindex $ret 1] 572 573 # 574 set nick "" 575 regsub ".* = " $output "" nick 576 set nick [string trim $nick] 577 set nick [string trim $nick "\;\n\""] 578 579 # if we couldn't update the sources, then we can't proceed 580 if {$status != 0} { 581 perror "bzr branch failed! " $output 582 } 583 return $nick 584} 585 586# run the Gnash autogen,sh script to regenerate config files. 587proc autogen {} { 588 global inp outp timeout srcdir 589 # recreate the build files 590 changedir $srcdir 591 procstart "Autogen" 592 set ret [local_exec "./autogen.sh" $inp $outp $timeout] 593 set status [lindex $ret 0] 594 set output [lindex $ret 1] 595 # if autogen.sh fails, then we can't proceed 596 if {$status != 0} { 597 perror "./autogen.sh failed! " $output 598 exit 1 599 } 600 procdone "Autogen" 601 return $output 602} 603 604# configure a checked out tree 605proc configure { opts } { 606 global inp outp timeout srcdir objdir 607 changedir $objdir 608 procstart "Configure" 609 610 # add any options to the sumfile 611 if {[string length $opts] > 0} { 612 sumfile "Configure options: $opts" 613 } 614 set ret [local_exec "$srcdir/configure $opts" $inp $outp $timeout] 615 set status [lindex $ret 0] 616 set output [lindex $ret 1] 617 # if configuring fails, then we can't proceed 618 if {$status != 0} { 619 perror "$srcdir/configure failed with these options: $configopts! $output" 620 exit 1 621 } 622 procdone "Configure" 623 return $output 624} 625 626# build a Debian package 627proc dpkg { opts } { 628 global inp outp timeout objdir package revno branch 629 630 # find the snapshot directory 631 foreach i [glob -nocomplain $objdir/gnash-*bzr*] { 632 if {[file isdirectory $i]} { 633 set build $i 634 changedir $i 635 break 636 } 637 } 638 639 set ret [local_exec "dpkg-buildpackage $opts" $inp $outp $timeout] 640 set status [lindex $ret 0] 641 set output [lindex $ret 1] 642 # if configuring fails, then we can't proceed 643 if {$status != 0} { 644 perror "dpkg-buildpackage failed with these options: $opts! $output" 645 exit 1 646 } 647 return $output 648} 649 650# run make to compile everything 651proc make { opts } { 652 global inp outp timeout make objdir 653 changedir $objdir 654 procstart "Make" 655 # add any options to the sumfile 656 if {[string length $opts] > 0} { 657 sumfile "Make flags: $opts" 658 } 659 set ret [local_exec "$make $opts" $inp $outp 1000] 660 set status [lindex $ret 0] 661 set output [lindex $ret 1] 662 # if configuring fails, then we can't proceed 663 if {$status != 0} { 664 perror "$make failed with these options: $opts! $output" 665 exit 1 666 } 667 procdone "Make" 668 return $output 669} 670 671# upload files to the repository 672proc upload { files } { 673 global inp outp timeout objdir uploadcmd 674 changedir $objdir 675 procstart "Upload" 676 if {$uploadcmd == "dupload"} { 677 set ret [local_exec "$uploadcmd $files" $inp $outp $timeout] 678 } 679 if {$uploadcmd == "scp"} { 680 set ret [local_exec "$uploadcmd $files" $inp $outp $timeout] 681 } 682 set status [lindex $ret 0] 683 set output [lindex $ret 1] 684 # if configuring fails, then we can't proceed 685 if {$status != 0} { 686 perror "$uploadcmd failed to upload $changes!: $output" 687 exit 1 688 } 689 690 procdone "Upload" 691 return $output 692} 693 694# remove old package builds 695proc clean {} { 696 set ret [local_exec "rm -fr gnash-*" $inp $outp $timeout] 697 set status [lindex $ret 0] 698 set output [lindex $ret 1] 699 # if configuring fails, then we can't proceed 700 if {$status != 0} { 701 perror "$uploadcmd failed to upload $changes!: $output" 702 exit 1 703 } 704 return $output 705} 706 707# see if this is a apt or rpm based system 708# All Debian based systems have this file, which no rpm based ones do 709if {[file exists /etc/network/interfaces]} { 710 set package "deb" 711} else { 712 set package "rpm" 713} 714 715verbose "Building a $package package" 716# 717# The real guts start here 718# 719 720# set a default timeoput value for comamnd exececution. Some commands, 721# like bzr checkouts can 722set timeout 600 723 724# 725# Switch to the source directory now 726# 727set startdir [pwd] 728 729# extract info so we know what we're building 730set revno [bzr_revno] 731set branch [bzr_branch] 732changedir $srcdir 733 734suminfo Gnash 735 736# the state table is the sequence of tasks required to build Gnash. 737while {$state != "done"} { 738 verbose "======= Current state is: $state =======" 739 switch -glob -- $state { 740 "b*" { # "bzr" 741 changedir $srcdir 742 verbose "Changed to source tree: $srcdir" 743 set output [bzr_update]; # update the source tree 744 # update the branch and revision after the update 745 set revno [bzr_revno] 746 set branch [bzr_branch] 747# if {[string match "*configure.ac*" $output]} { 748 set state "autogen.sh" 749# } else { 750# set state "configure" 751# } 752 } 753 754 "a*" { # "autogen.sh" 755 changedir $srcdir 756 autogen; # create the config and build files 757 set state "configure" 758 } 759 760 "co*" { # "configure" 761 # Switch to the build directory now 762 changedir $objdir 763 verbose "Changed to build tree: $objdir" 764 configure "$configopts" 765 set state "make" 766 } 767 768 "m*" { # "make" 769 changedir $objdir 770 make $package 771 set state "upload" 772 } 773 774 "dp*" { # "dpkg-buildpackage" 775 # This should only be run by package code maintainers, as this 776 # manually runs dpkg-buildpackage, and assumes everything is 777 # all setup correctly, or it'll fail. This is basically just 778 # an optimization step when debugging package building. 779 changedir $objdir 780 dpkg "-nc" 781 set state "upload" 782 set only yes 783 } 784 785 "u*" { # "upload" 786 changedir $objdir 787 #upload 788 set state "done" 789 } 790 791 "t*" { # "test" 792 changedir $objdir 793 # test the repository to make sure it worked 794 795 set state "upload" 796 } 797 798 "cl*" { # "clean" 799 # Switch to the build directory now 800 changedir $objdir 801 verbose "Changed to build tree: $objdir" 802 clean 803 set only yes 804 } 805 }; # end of switch 806 # exit the while loop if we only want to run one step of the state table 807 if { $only == "yes" } { 808 set state "done" 809 break; 810 } 811}; # end of while 812 813# back to where we started 814cd $startdir 815