Changeset 1485 in ProjectBuilder for projects/casparbuster/devel/bin


Ignore:
Timestamp:
Apr 23, 2012, 11:04:02 AM (12 years ago)
Author:
Bruno Cornec
Message:
  • Adds a Plugin module to support plugin management
  • cbusterize now works with both -s and -p options
  • One plugin example added (dhcpd)

-cb script started. Not working now

Location:
projects/casparbuster/devel/bin
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • projects/casparbuster/devel/bin/cb

    r1466 r1485  
    11#!/usr/bin/perl -w
    22#
    3 # Project Builder main application
    4 #
    5 # $Id$
    6 #
    7 # Copyright B. Cornec 2007-2011
    8 # Provided under the GPL v2
    9 
    10 # Syntax: see at end
    11 
    12 use strict 'vars';
    13 
    14 # The modules mentioned here are required by pb when used both
    15 # locally or inside a VE/VM/RM
    16 # Additional required modules only used locally are called with a require
    17 # in their respective section
    18 use Getopt::Long qw(:config auto_abbrev no_ignore_case);
     3=head1 NAME
     4
     5cb - CasparBuster looks at the structure in your CMS environment and deploy it to the target systems as needed
     6
     7=head1 SYNOPSIS
     8
     9cb [options]
     10
     11 Options:
     12   --debug  |-d         debug mode
     13   --help   |-h         brief help message
     14   --man            full documentation
     15   --force   |-f            force copy of files, even if they exist
     16   --source |-s <file/dir>  directory or files to copy from the CasparBuster tree (',' separated if many) to the target
     17   --plugin |-p <plugin name>   plugin defining what to copy from the CasparBuster tree (',' separated if many) to the target
     18   --machine|-m <machine>   machine to deploy on.
     19
     20=head1 OPTIONS
     21
     22=over 4
     23
     24=item B<--debug>
     25
     26Enter debug mode. This will print what would be done. No commands are executed,
     27so this is safe to use when testing.
     28
     29=item B<--help>
     30
     31Print a brief help message and exits.
     32
     33=item B<--man>
     34
     35Prints the manual page and exits.
     36
     37=item B<--machine> I<machine name>
     38
     39Specify the machine to consider when dealing with the CasparBuster structure.
     40The files will be pushed to this machine, and a subdirectory named after the machine
     41will be used under the basedir to look at the directory structure to deploy
     42
     43=item B<--source> I<path>
     44
     45Specify the path of the source file or directory to deploy with CasparBuster. Multiple paths can be specified separated by ','.
     46
     47=item B<--plugin> I<name>
     48
     49Specify the name of the plugin to deploy with CasparBuster. Multiple plugins can be specified separated by ','.
     50A plugin defines a set of files (with their mode and owner), a set of directories (with their mode and owner) and a set of scripts to launch once the files are copied remotely.
     51
     52=back
     53
     54=head1 DESCRIPTION
     55
     56Deploy the standard CasparBuster structure created by I<cbusterize>. It will reinstall all files and directory in the plugin, with correct owner, group and mode, and launch at the end the script to re-enable potentially the service using the updated files.
     57
     58=head1 EXAMPLES
     59
     60    # this will deploy the appropriate CasparBuster environment for DHCP
     61    # from the base ~/prj/musique-ancienne.org directory (Cf cbbasedir in cb.conf)
     62    # containing the directory victoria2 for this machine
     63    # to which it will copy the required files
     64
     65    cb -m victoria2 -p dhcpd
     66
     67=head1 AUTHOR
     68
     69=over 4
     70
     71Bruno Cornec, http://brunocornec.wordpress.com
     72
     73=back
     74
     75=head1 LICENSE
     76
     77Copyright (C) 2012  Bruno Cornec <bruno@project-builder.org>
     78Released under the GPLv2 or the Artistic license at your will.
     79
     80=cut
     81use strict;
     82use CasparBuster::Version;
     83use CasparBuster::Env;
     84use CasparBuster::Plugin;
     85#use Cwd 'realpath';
     86use File::Find;
     87use File::Copy;
     88use File::Basename;
     89use File::Path;
     90use File::Glob ':glob';
     91use Getopt::Long;
     92use Pod::Usage;
    1993use Data::Dumper;
    20 use English;
    21 use File::Basename;
    22 use File::Copy;
    23 use File::stat;
    24 use File::Temp qw(tempdir);
    25 use File::Find;
    26 use Time::localtime qw(localtime);
    27 use POSIX qw(strftime);
    28 use lib qw (lib);
    29 use ProjectBuilder::Version;
     94use List::Util qw(first);
    3095use ProjectBuilder::Base;
    31 use ProjectBuilder::Display;
    3296use ProjectBuilder::Conf;
    33 use ProjectBuilder::Distribution;
    34 use ProjectBuilder::CMS;
    35 use ProjectBuilder::Env;
    36 use ProjectBuilder::Filter;
    37 use ProjectBuilder::Changelog;
    38 use ProjectBuilder::VE;
    39 
    40 # Global variables
    41 my %opts;                   # CLI Options
    42 my $action;                 # action to realize
    43 my $test = "FALSE";         # Not used
    44 my $pbforce = 0;            # Force VE/VM rebuild
    45 my $pbsnap = 0;             # Do not use snapshot mode for VM/VE by default
    46 my $pbkeep = 0;             # keep temporary directory at the end
    47 my $option = "";            # Not used
    48 my @pkgs;                   # list of packages
    49 my $pbtag;                  # Global Tag variable
    50 my $pbver;                  # Global Version variable
    51 my $pbscript;               # Name of the script
    52 my %pbver;                  # per package
    53 my %pbtag;                  # per package
    54 my $pbrev;                  # Global REVISION variable
    55 my $pbaccount;              # Login to use to connect to the VM/RM
    56 my $pbtarget = undef;       # Target os-ver-arch you want to build for
    57 my $pbport;                 # Port to use to connect to the VM/RM
    58 my $newver;                 # New version to create
    59 my $iso = undef;            # ISO image for the VM to create
    60 
    61 my @date = pb_get_date();
    62 my $pbdate = strftime("%Y-%m-%d", @date);
    63 
    64 =pod
    65 
    66 =head1 NAME
    67 
    68 pb, aka project-builder.org - builds packages for your projects
    69 
    70 =head1 DESCRIPTION
    71 
    72 pb helps you build various packages directly from your project sources.
    73 Those sources could be handled by a CMS (Configuration Management System)
    74 such as Subversion, CVS, Git, Mercurial... or being a simple reference to a compressed tar file.
    75 It's based on a set of configuration files, a set of provided macros to help
    76 you keeping build files as generic as possible. For example, a single .spec
    77 file should be required to generate for all rpm based distributions, even
    78 if you could also have multiple .spec files if required.
    79 
    80 =head1 SYNOPSIS
    81 
    82 pb [-vhSq][-r pbroot][-p project][[-s script -a account -P port][-t [os-ver-arch]][-m os-ver-arch[,...]]][-g][-i iso] <action> [<pkg1> ...]
    83 
    84 pb [--verbose][--help][--man][--quiet][--snapshot][--revision pbroot][--project project][[--script script --account account --port port][--target [os-ver-arch]][--machine os-ver-arch[,...]]][--nographic][--iso iso][--rebuild] <action> [<pkg1> ...]
    85 
    86 =head1 OPTIONS
    87 
    88 =over 4
    89 
    90 =item B<-v|--verbose>
    91 
    92 Print a brief help message and exits.
    93 
    94 =item B<-q|--quiet>
    95 
    96 Do not print any output.
    97 
    98 =item B<-h|--help>
    99 
    100 Print a brief help message and exits.
    101 
    102 =item B<-S|--snapshot>
    103 
    104 Use the snapshot mode of VMs or VEs
    105 
    106 =item B<--man>
    107 
    108 Prints the manual page and exits.
    109 
    110 =item B<-t|--target os-ver-arch>
    111 
    112 Name of the target system you want to build for.
    113 All if none precised.
    114 
    115 =item B<-m|--machine os-ver-arch[,os-ver-arch,...]>
    116 
    117 Name of the Virtual Machines (VM), Virtual Environments (VE) or Remote Machines (RM)
    118 you want to build on (coma separated).
    119 All if none precised (or use the env variable PBV).
    120 
    121 =item B<-s|--script script>
    122 
    123 Name of the script you want to execute on the related VMs/VEs/RMs.
    124 
    125 =item B<-g|--nographic>
    126 
    127 Do not launch VMs in graphical mode.
    128 
    129 =item B<-i|--iso iso_image>
    130 
    131 Name of the ISO image of the distribution you want to install on the related VMs.
    132 
    133 =item B<-a|--account account>
    134 
    135 Name of the account to use to connect on the related VMs/RMs.
    136 
    137 =item B<-P|--port port_number>
    138 
    139 Port number to use to connect on the related VMs/RMs.";
    140 
    141 =item B<-p|--project project_name>
    142 
    143 Name of the project you're working on (or use the env variable PBPROJ)
    144 
    145 =item B<-r|--revision revision>
    146 
    147 Path Name of the project revision under the CMS (or use the env variable PBROOT)
    148 
    149 =item B<-V|--version new_version>
    150 
    151 New version of the project to create based on the current one.
    152 
    153 =item B<-k|--keep>
    154 
    155 Keep the temporary dir where files have been created in or der to help debug
    156 
    157 =item B<--rebuild>
    158 
    159 Only valid with the checkssh action, it alllows to automatically relaunch the build of the failed packages
    160 
    161 =back
    162 
    163 =head1 ARGUMENTS
    164 
    165 <action> can be:
    166 
    167 =over 4
    168 
    169 =item B<sbx2build>
    170 
    171 Create tar files for the project under your CMS.
    172 Current state of the exported content is taken.
    173 CMS supported are SVN, SVK, CVS, Git and Mercurial
    174 parameters are packages to build
    175 if not using default list
    176 
    177 =item B<cms2build>
    178 
    179 Create tar files for the project under your CMS.
    180 Current state of the CMS is taken.
    181 CMS supported are SVN, SVK, CVS, Git and Mercurial
    182 parameters are packages to build
    183 if not using default list
    184 
    185 =item B<build2pkg>
    186 
    187 Create packages for your running distribution
    188 
    189 =item B<cms2pkg>
    190 
    191 cms2build + build2pkg
    192 
    193 =item B<sbx2pkg>
    194 
    195 sbx2build + build2pkg
    196 
    197 =item B<build2ssh>
    198 
    199 Send the tar files to a SSH host
    200 
    201 =item B<sbx2ssh>
    202 
    203 sbx2build + build2ssh
    204 
    205 =item B<cms2ssh>
    206 
    207 cms2build + build2ssh
    208 
    209 =item B<pkg2ssh>
    210 
    211 Send the packages built to a SSH host
    212 
    213 =item B<build2vm>
    214 
    215 Create packages in VMs, launching them if needed
    216 and send those packages to a SSH host once built
    217 VM type supported are QEMU and KVM
    218 
    219 =item B<build2ve>
    220 
    221 Create packages in VEs, creating it if needed
    222 and send those packages to a SSH host once built
    223 
    224 =item B<build2rm>
    225 
    226 Create packages in RMs, which should pre-exist,
    227 and send those packages to a SSH host once built
    228 RM means Remote Machine, and could be a physical or Virtual one.
    229 This is one buildfarm integration for pb.
    230 
    231 =item B<sbx2vm>
    232 
    233 sbx2build + build2vm
    234 
    235 =item B<sbx2ve>
    236 
    237 sbx2build + build2ve
    238 
    239 =item B<sbx2rm>
    240 
    241 sbx2build + build2rm
    242 
    243 =item B<cms2vm>
    244 
    245 cms2build + build2vm
    246 
    247 =item B<cms2ve>
    248 
    249 cms2build + build2ve
    250 
    251 =item B<cms2rm>
    252 
    253 cms2build + build2rm
    254 
    255 =item B<launchvm>
    256 
    257 Launch one virtual machine
    258 
    259 =item B<launchve>
    260 
    261 Launch one virtual environment
    262 
    263 =item B<script2vm>
    264 
    265 Launch one virtual machine if needed
    266 and executes a script on it
    267 
    268 =item B<script2ve>
    269 
    270 Execute a script in a virtual environment
    271 
    272 =item B<script2rm>
    273 
    274 Execute a script on a remote machine
    275 
    276 =item B<newvm>
    277 
    278 Create a new virtual machine
    279 
    280 =item B<newve>
    281 
    282 Create a new virtual environment
    283 
    284 =item B<setupvm>
    285 
    286 Setup a virtual machine for pb usage
    287 
    288 =item B<setupve>
    289 
    290 Setup a virtual environment for pb usage
    291 
    292 =item B<setuprm>
    293 
    294 Setup a remote machine for pb usage
    295 
    296 =item B<sbx2setupvm>
    297 
    298 Setup a virtual machine for pb usage using the sandbox version of pb instead of the latest stable
    299 Reserved to dev team.
    300 
    301 =item B<sbx2setupve>
    302 
    303 Setup a virtual environment for pb usage using the sandbox version of pb instead of the latest stable
    304 Reserved to dev team.
    305 
    306 =item B<sbx2setuprm>
    307 
    308 Setup a remote machine for pb usage using the sandbox version of pb instead of the latest stable
    309 Reserved to dev team.
    310 
    311 =item B<snapvm>
    312 
    313 Snapshot a virtual machine for pb usage
    314 
    315 =item B<snapve>
    316 
    317 Snapshot a virtual environment for pb usage
    318 
    319 =item B<updatevm>
    320 
    321 Update the distribution in the virtual machine
    322 
    323 =item B<updateve>
    324 
    325 Update the distribution in the virtual environment
    326 
    327 =item B<updaterm>
    328 
    329 Update the distribution in the remote machine
    330 
    331 =item B<test2pkg>
    332 
    333 Test a package locally
    334 
    335 =item B<test2vm>
    336 
    337 Test a package in a virtual machine
    338 
    339 =item B<test2ve>
    340 
    341 Test a package in a virtual environment
    342 
    343 =item B<test2rm>
    344 
    345 Test a package in a remote machine
    346 
    347 =item B<checkssh>
    348 
    349 Check the delivery of the packages on the repository
    350 
    351 =item B<newver>
    352 
    353 Create a new version of the project derived
    354 from the current one
    355 
    356 =item B<newproj>
    357 
    358 Create a new project and a template set of
    359 configuration files under pbconf
    360 
    361 =item B<announce>
    362 
    363 Announce the availability of the project through various means
    364 
    365 =item B<sbx2webssh>
    366 
    367 Create tar files for the website under your CMS.
    368 Current state of the exported content is taken.
    369 Deliver the content to the target server using ssh from the exported dir.
    370 
    371 =item B<cms2webssh>
    372 
    373 Create tar files for the website from your CMS.
    374 Deliver the content to the target server using ssh from the DVCS.
    375 
    376 =item B<sbx2webpkg>
    377 
    378 Create tar files for the website under your CMS.
    379 Current state of the exported content is taken.
    380 
    381 =item B<cms2webpkg>
    382 
    383 Create tar files for the website under your CMS.
    384 
    385 =item B<clean>
    386 
    387 Purge the build and delivery directories related to the current project
    388 
    389 =back
    390 
    391 =item B<cleanssh>
    392 
    393 Purge the ssh server of its packages (only for testver and test packages)
    394 
    395 =back
    396 
    397 <pkgs> can be a list of packages, the keyword 'all' or nothing, in which case the default list of packages is taken (corresponding to the defpkgdir list of arguments in the configuration file).
    398 
    399 =head1 WEB SITES
    400 
    401 The main Web site of the project is available at L<http://www.project-builder.org/>. Bug reports should be filled using the trac instance of the project at L<http://trac.project-builder.org/>.
    402 
    403 =head1 USER MAILING LIST
    404 
    405 None exists for the moment.
    406 
    407 =head1 CONFIGURATION FILES
    408 
    409 Each pb user may have a configuration in F<$HOME/.pbrc>. The values in this file may overwrite any other configuration file value.
    410 
    411 Here is an example of such a configuration file:
    412 
    413  #
    414  # Define for each project the URL of its pbconf repository
    415  # No default option allowed here as they need to be all different
    416  #
    417  # URL of the pbconf content
    418  # This is the format of a classical URL with the extension of additional schema such as
    419  # svn+ssh, cvs+ssh, ...
    420  #
    421  pbconfurl linuxcoe = cvs+ssh://:ext:bcornec@linuxcoe.cvs.sourceforge.net:/cvsroot/linuxcoe/pbconf
    422 
    423  # This is normaly defined in the project's configuration file
    424  # Url of the project
    425  #
    426  pburl linuxcoe = cvs+ssh://:ext:bcornec@linuxcoe.cvs.sourceforge.net:/cvsroot/linuxcoe
    427  
    428  # All these URLs needs to be defined here as the are the entry point
    429  # for how to build packages for the project
    430  #
    431  pbconfurl pb = svn+ssh://svn.project-builder.org/mondo/svn/pb/pbconf
    432  pbconfurl mondorescue = svn+ssh://svn.project-builder.org/mondo/svn/project-builder/mondorescue/pbconf
    433  pbconfurl collectl = svn+ssh://bruno@svn.mondorescue.org/mondo/svn/project-builder/collectl/pbconf
    434  pbconfurl netperf = svn+ssh://svn.mondorescue.org/mondo/svn/project-builder/netperf/pbconf
    435  
    436  # Under that dir will take place everything related to pb
    437  # If you want to use VMs/chroot/..., then use $ENV{'HOME'} to make it portable
    438  # to your VMs/chroot/...
    439  # if not defined then /var/cache
    440  pbdefdir default = $ENV{'HOME'}/project-builder
    441  pbdefdir pb = $ENV{'HOME'}
    442  pbdefdir linuxcoe = $ENV{'HOME'}/LinuxCOE/cvs
    443  pbdefdir mondorescue = $ENV{'HOME'}/mondo/svn
    444  
    445  # pbconfdir points to the directory where the CMS content of the pbconfurl is checked out
    446  # If not defined, pbconfdir is under pbdefdir/pbproj/pbconf
    447  pbconfdir linuxcoe = $ENV{'HOME'}/LinuxCOE/cvs/pbconf
    448  pbconfdir mondorescue = $ENV{'HOME'}/mondo/svn/pbconf
    449  
    450  # pbdir points to the directory where the CMS content of the pburl is checked out
    451  # If not defined, pbdir is under pbdefdir/pbproj
    452  # Only defined if we have access to the dev of the project
    453  pbdir linuxcoe = $ENV{'HOME'}/LinuxCOE/cvs
    454  pbdir mondorescue = $ENV{'HOME'}/mondo/svn
    455  
    456  # -daemonize doesn't work with qemu 0.8.2
    457  vmopt default = -m 384
    458 
    459 =head1 AUTHORS
    460 
    461 The Project-Builder.org team L<http://trac.project-builder.org/> lead by Bruno Cornec L<mailto:bruno@project-builder.org>.
    462 
    463 =head1 COPYRIGHT
    464 
    465 Project-Builder.org is distributed under the GPL v2.0 license
    466 described in the file C<COPYING> included with the distribution.
    467 
    468 =cut
    469 
    470 # ---------------------------------------------------------------------------
    471 
    472 my ($projectbuilderver,$projectbuilderrev) = pb_version_init();
    473 my $appname = "pb";
     97use ProjectBuilder::VCS;
     98use DBI;
     99use DBD::SQLite;
     100
     101# settings
     102my $debug = 0;
     103my $help = undef;
     104my $man = undef;
     105my $source = undef;
     106my $machine = undef;
     107my $plugin = undef;
     108my $quiet = undef;
     109my $force = undef;
     110my $log = undef;
     111my $LOG = undef;
     112
     113my ($cbver,$cbrev) = cb_version_init();
     114my $appname = "cb";
     115$ENV{'PBPROJ'} = $appname;
     116pb_temp_init();
    474117
    475118# Initialize the syntax string
    476 
    477 pb_syntax_init("$appname (aka project-builder.org) Version $projectbuilderver-$projectbuilderrev\n");
    478 
    479 GetOptions("help|?|h" => \$opts{'h'},
    480         "man" => \$opts{'man'},
    481         "verbose|v+" => \$opts{'v'},
    482         "snapshot|S" => \$opts{'S'},
    483         "quiet|q" => \$opts{'q'},
    484         "log-files|l=s" => \$opts{'l'},
    485         "force|f" => \$opts{'f'},
    486         "account|a=s" => \$opts{'a'},
    487         "revision|r=s" => \$opts{'r'},
    488         "script|s=s" => \$opts{'s'},
    489         "machines|mock|m=s" => \$opts{'m'},
    490         "target|t:s" => \$opts{'t'},
    491         "nographic|g" => \$opts{'g'},
    492         "port|P=i" => \$opts{'P'},
    493         "project|p=s" => \$opts{'p'},
    494         "rebuild" => \$opts{'rebuild'},
    495         "iso|i=s" => \$opts{'i'},
    496         "version|V=s" => \$opts{'V'},
    497         "keep|k" => \$opts{'k'},
     119pb_syntax_init("$appname (aka CasparBuster) Version $cbver-$cbrev\n");
     120
     121# parse command-line options
     122GetOptions(
     123    'machine|m=s' => \$machine,
     124    'debug|d+'    => \$debug,
     125    'help|h'      => \$help,
     126    'quiet|q'     => \$quiet,
     127    'force|f'     => \$force,
     128    'man'         => \$man,
     129    'logfile|l=s' => \$log,
     130    'source|s=s'  => \$source,
     131    'plugin|p=s'  => \$plugin,
    498132) || pb_syntax(-1,0);
    499133
    500 if (defined $opts{'h'}) {
     134if (defined $help) {
    501135    pb_syntax(0,1);
    502136}
    503 if (defined $opts{'man'}) {
     137if (defined $man) {
    504138    pb_syntax(0,2);
    505139}
    506 if (defined $opts{'v'}) {
    507     $pbdebug = $opts{'v'};
    508 }
    509 if (defined $opts{'f'}) {
    510     $pbforce=1;
    511 }
    512 if (defined $opts{'q'}) {
    513     $pbdebug=-1;
    514 }
    515 if (defined $opts{'S'}) {
    516     $pbsnap=1;
    517 }
    518 if (defined $opts{'k'}) {
    519     $pbkeep=1;
    520 }
    521 if (defined $opts{'l'}) {
    522     open(pbLOG,"> $opts{'l'}") || die "Unable to log to $opts{'l'}: $!";
    523     $pbLOG = \*pbLOG;
    524     $pbdebug = 0  if ($pbdebug == -1);
    525     }
    526 pb_log_init($pbdebug, $pbLOG);
    527 pb_display_init("text","");
    528 
    529 # Handle root of the project if defined
    530 if (defined $opts{'r'}) {
    531     $ENV{'PBROOTDIR'} = $opts{'r'};
    532 }
    533 # Handle virtual machines if any
    534 if (defined $opts{'m'}) {
    535     $ENV{'PBV'} = $opts{'m'};
    536 }
    537 if (defined $opts{'s'}) {
    538     $pbscript = $opts{'s'};
    539 }
    540 if (defined $opts{'a'}) {
    541     $pbaccount = $opts{'a'};
    542     die "option -a requires a -s script option" if (not defined $pbscript);
    543 }
    544 if (defined $opts{'P'}) {
    545     $pbport = $opts{'P'};
    546 }
    547 if (defined $opts{'V'}) {
    548     $newver = $opts{'V'};
    549 }
    550 if (defined $opts{'i'}) {
    551     $iso = $opts{'i'};
    552 }
    553 if (defined $opts{'t'}) {
    554     $pbtarget = $opts{'t'};
    555 }
    556 
    557 # Get Action
    558 $action = shift @ARGV;
    559 die pb_syntax(-1,1) if (not defined $action);
    560 
    561 my ($filteredfiles, $supfiles, $defpkgdir, $extpkgdir);
    562 my $pbinit = undef;
    563 $pbinit = 1 if ($action =~ /^newproj$/);
    564 
    565 # Handles project name if any
    566 # And get global params
    567 ($filteredfiles, $supfiles, $defpkgdir, $extpkgdir) = pb_env_init($opts{'p'},$pbinit,$action,$pbkeep);
    568 
    569 #
    570 # Check for command requirements
    571 #
    572 my ($req,$opt,$pbpara) = pb_conf_get_if("oscmd","oscmdopt","pbparallel");
    573 pb_check_requirements($req,$opt,$appname);
    574 
    575 #
    576 # Check if we can launch some actions in // with Parallel::ForkManager
    577 #
    578 my $pbparallel = $pbpara->{$appname} if (defined $pbpara);
    579 if (not defined $pbparallel) {
    580     eval
    581     {
    582         require Sys::CPU;
    583         Sys::CPU->import();
    584     };
    585     if ($@) {
    586         # Sys::CPU not found, defaulting to 1
    587         pb_log(1,"ADVISE: Install Sys::CPU to benefit from automatic parallelism optimization.\nOr use pbparallel in your pb.conf file\nOnly 1 process at a time for the moment\n");
    588         $pbparallel = 1;
    589     } else {
    590         # Using the number of cores
    591         $pbparallel = Sys::CPU::cpu_count();
    592         pb_log(1,"Using parallel mode with $pbparallel processes\n");
    593     }
    594 }
    595 
    596 eval
    597 {
    598     require Parallel::ForkManager;
    599     Parallel::ForkManager->import();
    600 };
    601 # Parallel::ForkManager not found so no // actions
    602 if ($@) {
    603     $pbparallel = undef;
    604     pb_log(1,"ADVISE: Install Parallel::ForkManager to benefit from automatic parallelism optimization.\nOnly 1 process at a time for the moment\n");
    605 }
    606 
    607 pb_log(0,"Project: $ENV{'PBPROJ'}\n");
    608 pb_log(0,"Action: $action\n");
    609 
    610 # Act depending on action
    611 if ($action =~ /^cms2build$/) {
    612     pb_cms2build("CMS");
    613 } elsif ($action =~ /^sbx2build$/) {
    614     pb_cms2build("SandBox");
    615 } elsif ($action =~ /^build2pkg$/) {
    616     pb_build2pkg();
    617 } elsif ($action =~ /^cms2pkg$/) {
    618     pb_cms2build("CMS");
    619     pb_build2pkg();
    620 } elsif ($action =~ /^sbx2pkg$/) {
    621     pb_cms2build("SandBox");
    622     pb_build2pkg();
    623 } elsif ($action =~ /^build2ssh$/) {
    624     pb_build2ssh();
    625 } elsif ($action =~ /^cms2ssh$/) {
    626     pb_cms2build("CMS");
    627     pb_build2ssh();
    628 } elsif ($action =~ /^sbx2ssh$/) {
    629     pb_cms2build("SandBox");
    630     pb_build2ssh();
    631 } elsif ($action =~ /^pkg2ssh$/) {
    632     pb_pkg2ssh();
    633 } elsif ($action =~ /^build2rm$/) {
    634     pb_build2v("rm","build");
    635 } elsif ($action =~ /^build2ve$/) {
    636     pb_build2v("ve","build");
    637 } elsif ($action =~ /^build2vm$/) {
    638     pb_build2v("vm","build");
    639 } elsif ($action =~ /^cms2rm$/) {
    640     pb_cms2build("CMS");
    641     pb_build2v("rm","build");
    642 } elsif ($action =~ /^cms2ve$/) {
    643     pb_cms2build("CMS");
    644     pb_build2v("ve","build");
    645 } elsif ($action =~ /^sbx2rm$/) {
    646     pb_cms2build("SandBox");
    647     pb_build2v("rm","build");
    648 } elsif ($action =~ /^sbx2ve$/) {
    649     pb_cms2build("SandBox");
    650     pb_build2v("ve","build");
    651 } elsif ($action =~ /^cms2vm$/) {
    652     pb_cms2build("CMS");
    653     pb_build2v("vm","build");
    654 } elsif ($action =~ /^sbx2vm$/) {
    655     pb_cms2build("SandBox");
    656     pb_build2v("vm","build");
    657 } elsif ($action =~ /^launchvm$/) {
    658     pb_launchv("vm",$ENV{'PBV'},0);
    659 } elsif ($action =~ /^launchve$/) {
    660     pb_launchv("ve",$ENV{'PBV'},0);
    661 } elsif ($action =~ /^script2vm$/) {
    662     pb_script2v($pbscript,"vm");
    663 } elsif ($action =~ /^script2ve$/) {
    664     pb_script2v($pbscript,"ve");
    665 } elsif ($action =~ /^script2rm$/) {
    666     pb_script2v($pbscript,"rm");
    667 } elsif ($action =~ /^newver$/) {
    668     pb_newver();
    669 } elsif ($action =~ /^newve$/) {
    670     pb_launchv("ve",$ENV{'PBV'},1);
    671 } elsif ($action =~ /^newvm$/) {
    672     pb_launchv("vm",$ENV{'PBV'},1);
    673     pb_log(0, "Please ensure that sshd is running in your VM by default\n");
    674     pb_log(0, "and that it allows remote root login (PermitRootLogin yes in /etc/ssh/sshd_config)\n");
    675     pb_log(0, "Also ensure that network is up, firewalling correctly configured\n");
    676     pb_log(0, "and perl, sudo, ntpdate and scp/ssh installed\n");
    677     pb_log(0, "You should then be able to login with ssh -p VMPORT root\@localhost (if VM started with pb)\n");
    678 } elsif ($action =~ /^setuprm$/) {
    679     pb_setup2v("rm");
    680 } elsif ($action =~ /^setupve$/) {
    681     pb_setup2v("ve");
    682 } elsif ($action =~ /^setupvm$/) {
    683     pb_setup2v("vm");
    684 } elsif ($action =~ /^sbx2setuprm$/) {
    685     die "This feature is limited to the pb project" if ($ENV{'PBPROJ'} ne $appname);
    686     pb_cms2build("SandBox");
    687     pb_setup2v("rm","SandBox");
    688 } elsif ($action =~ /^sbx2setupve$/) {
    689     die "This feature is limited to the pb project" if ($ENV{'PBPROJ'} ne $appname);
    690     pb_cms2build("SandBox");
    691     pb_setup2v("ve","SandBox");
    692 } elsif ($action =~ /^sbx2setupvm$/) {
    693     die "This feature is limited to the pb project" if ($ENV{'PBPROJ'} ne $appname);
    694     pb_cms2build("SandBox");
    695     pb_setup2v("vm","SandBox");
    696 } elsif ($action =~ /^updaterm$/) {
    697     pb_update2v("rm");
    698 } elsif ($action =~ /^updateve$/) {
    699     pb_update2v("ve");
    700 } elsif ($action =~ /^updatevm$/) {
    701     pb_update2v("vm");
    702 } elsif ($action =~ /^snapve$/) {
    703     pb_snap2v("ve");
    704 } elsif ($action =~ /^snapvm$/) {
    705     pb_snap2v("vm");
    706 } elsif ($action =~ /^test2pkg$/) {
    707     pb_test2pkg();
    708 } elsif ($action =~ /^test2rm$/) {
    709     pb_build2v("rm","test");
    710 } elsif ($action =~ /^test2ve$/) {
    711     pb_build2v("ve","test");
    712 } elsif ($action =~ /^test2vm$/) {
    713     pb_build2v("vm","test");
    714 } elsif ($action =~ /^newproj$/) {
    715     # Nothing to do - already done in pb_env_init
    716 } elsif ($action =~ /^clean$/) {
    717     pb_clean();
    718 } elsif ($action =~ /^announce$/) {
    719     # For announce only. Require avoids the systematic load of these modules
    720     require DBI;
    721     require DBD::SQLite;
    722 
    723     pb_announce("Announce");
    724 } elsif ($action =~ /^cleanssh$/) {
    725     pb_announce("Clean");
    726 } elsif ($action =~ /^checkssh$/) {
    727     pb_announce("Check");
    728 } elsif ($action =~ /^sbx2webpkg$/) {
    729     require DBI;
    730     require DBD::SQLite;
    731 
    732     pb_cms2build("SandBox","Web");
    733 } elsif ($action =~ /^sbx2webssh$/) {
    734     require DBI;
    735     require DBD::SQLite;
    736 
    737     pb_cms2build("SandBox","Web");
    738     pb_send2target("Web");
    739 } elsif ($action =~ /^cms2webpkg$/) {
    740     require DBI;
    741     require DBD::SQLite;
    742 
    743     pb_cms2build("CMS","Web");
    744 } elsif ($action =~ /^cms2webssh$/) {
    745     require DBI;
    746     require DBD::SQLite;
    747 
    748     pb_cms2build("CMS","Web");
    749     pb_send2target("Web");
     140if (defined $quiet) {
     141    $debug=-1;
     142}
     143if (defined $log) {
     144    open(LOG,"> $log") || die "Unable to log to $log: $!";
     145    $LOG = \*LOG;
     146    $debug = 0  if ($debug == -1);
     147}
     148
     149$pbdebug = $debug;
     150pb_log_init($debug, $LOG);
     151pb_log(0,"Starting cb\n");
     152
     153# Get conf file in context
     154pb_conf_init($appname);
     155# The personal one if there is such
     156pb_conf_add("$ENV{'HOME'}/.cbrc") if (-f "$ENV{'HOME'}/.cbrc");
     157# The system one
     158pb_conf_add(cb_env_conffile());
     159
     160# Get configuration parameters
     161my %cb;
     162my $cb = \%cb;
     163($cb->{'basedir'},$cb->{'usemachines'},$cb->{'cms'},$cb->{'database'}) = pb_conf_get("cbbasedir","cbusemachines","cbcms","cbdatabase");
     164pb_log(2,"%cb: ",Dumper($cb));
     165
     166# Check for mandatory params
     167
     168if (defined $plugin) {
     169    # Load plugins
     170    cb_plugin_load();
     171}
     172
     173my $basedir = $cb->{'basedir'}->{$appname};
     174eval { $basedir =~ s/(\$ENV.+\})/$1/eeg };
     175
     176pb_log(1, "DEBUG MODE, not doing anything, just printing\nDEBUG: basedir = $basedir\n");
     177
     178# Use potentially a remote account if defined
     179my $account = undef;
     180my $remote = $machine;
     181($account) = pb_conf_get_if("cbaccount") if (defined $machine);
     182$remote = $account->{$machine}."@".$machine if ((defined $account) && (defined $account->{$machine}));
     183pb_log(1, "DEBUG: remote = $remote\n") if (defined $remote);
     184
     185# Create basedir if it doesn't exist
     186die "Unable to find base directory at $basedir" if (not -d $basedir);
     187
     188# Now handle plugins if any
     189my $cbp = ();
     190
     191if (defined $plugin) {
     192    foreach my $p (split(/,/,$plugin)) {   
     193        pb_log(1,"Getting context for plugin $p\n");
     194        $cbp = cb_plugin_get($p,$cbp);
     195        pb_log(2,"cbp: ".Dumper($cbp)."\n");
     196    }
     197}
     198
     199my $db = "$cb->{'basedir'}/$cb->{'database'}";
     200
     201my $precmd = "";
     202if (! -f $db) {
     203    $precmd = "CREATE TABLE dates (id INTEGER PRIMARY KEY AUTOINCREMENT, date DATE, file VARCHAR[65535])";
     204}
     205
     206my $dbh = DBI->connect("dbi:SQLite:dbname=$db","","",
     207            { RaiseError => 1, AutoCommit => 1 })
     208            || die "Unable to connect to $db";
     209
     210if ($precmd ne "") {
     211    my $sth = $dbh->prepare(qq{$precmd}) || die "Unable to create table into $db";
     212    if ($debug) {
     213            pb_log(1,"DEBUG: Creatung DB $db\n");
     214            pb_log(1,"DEBUG: with command $precmd\n");
     215    } else {
     216        $sth->execute();
     217    }
     218}
     219
     220my $dest = "$ENV{'TMPDIR'}/vcs.$$";
     221pb_vcs_export(,$cb->{'basedir'},$dest);
     222
     223# Is the source a file or a dir ? Split the source parameter in 2
     224my $srcdir = undef;
     225my $srcfile = undef;
     226my $cmd = undef;
     227
     228if (not defined $machine) {
     229    if (-d $source) {
     230        $srcdir = $source;
     231    } else {
     232        $srcdir = dirname($source);
     233        $srcfile = basename($source);
     234    }
    750235} else {
    751     pb_log(0,"\'$action\' is not available\n");
    752     pb_syntax(-2,1);
    753 }
    754 
    755 sub pb_cms2build {
    756 
    757     my $param = shift || undef;
    758     my $web = shift || undef;
    759 
    760     my $pkg;
    761     my @pkgs;
    762     my $webdir;
    763 
    764     my %pkgs;
    765     my $pb;             # Structure to store conf info
    766 
    767     die "pb_cms2build requires a parameter: SandBox or CMS" if (not defined $param);
    768 
    769     # If Website, then pkg is only the website
    770     if (defined $web) {
    771         ($webdir) = pb_conf_get("webdir");
    772         pb_log(2,"webdir: ".Dumper($webdir)."\n");
    773         $pkgs[0] = $webdir->{$ENV{'PBPROJ'}};
    774         $extpkgdir = $webdir;
    775         pb_log(0,"Package: $pkgs[0]\n");
    776     } else {
    777         $pkg = pb_cms_get_pkg($defpkgdir,$extpkgdir);
    778         @pkgs = @$pkg;
    779     }
    780 
    781     my ($scheme, $uri) = pb_cms_init($pbinit,$param);
    782 
    783     # We need 2 lines here
    784     my ($pkgv, $pkgt, $testver) = pb_conf_get_if("pkgver","pkgtag","testver");
    785 
    786     # declare packager and repo for filtering
    787     my ($tmp1, $tmp2) = pb_conf_get("pbpackager","pbrepo");
    788     $ENV{'PBPACKAGER'} = $tmp1->{$ENV{'PBPROJ'}};
    789     $ENV{'PBREPO'} = $tmp2->{$ENV{'PBPROJ'}};
    790     my ($delivery) = pb_conf_get_if("delivery");
    791     $delivery->{$ENV{'PBPROJ'}} = "" if (not defined $delivery->{$ENV{'PBPROJ'}});
    792 
    793     # If we deal with a test dir, we want to keep the date in tar file and dir name
    794     my $pbextdir = "";
    795         if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
    796             $pbextdir = strftime("%Y%m%d%H%M%S", @date);
    797     }
    798 
    799     foreach my $pbpkg (@pkgs) {
    800         $ENV{'PBPKG'} = $pbpkg;
    801 
    802         if ((defined $pkgv) && (defined $pkgv->{$pbpkg})) {
    803             $pbver = $pkgv->{$pbpkg};
     236    $cmd = "ssh -q $remote \'echo \"if [ -d $source ]; then exit 0; else exit -1; fi\" | sudo bash\'";
     237    my $res = pb_system($cmd,"","quiet");
     238    pb_log(2,"DEBUG: Found res = $res\n");
     239    if ($res == 0) {
     240        $srcdir = $source;
     241        pb_log(1,"DEBUG: Found remote dir = $source\n");
     242    } else {
     243        $srcdir = dirname($source);
     244        $srcfile = basename($source);
     245        pb_log(1,"DEBUG: Found remote file = $source\n");
     246    }
     247}
     248
     249pb_log(1,"DEBUG: Found srcdir = $srcdir\n");
     250if (defined $srcfile) {
     251    pb_log(1,"DEBUG: Found srcfile = $srcfile\n");
     252} else {
     253    pb_log(1,"DEBUG: Found no srcfile\n");
     254}
     255
     256# Deduce the target directory from the local structure and the source
     257my $target = $basedir;
     258$target .= "/$machine" if defined ($machine);
     259$target .= "$srcdir";
     260
     261my $scheme = $cb->{'cms'}->{$appname};
     262
     263# If both source and target are dirs, then copy into the parent of the target
     264$target = basename($target) if ((not defined $srcfile) && (-d $target));
     265
     266# Create target if it doesn't exist when we have to copy a file
     267if ((not -d $target) && (defined $srcfile)) {
     268    if ($debug) {
     269        pb_log(1,"DEBUG: Creating recursively directory $target\n");
     270    } else {
     271        pb_mkdir_p($target) || die "Unable to recursively create $target: $!";
     272        pb_vcs_add($scheme,$target);
     273        pb_log(0,"INFO: Created $target and added it to your $scheme system\n");
     274    }
     275}
     276
     277# We need to know where to get the content from
     278my $cmdopt = "";
     279
     280# Recursive if we copy dirs
     281$cmdopt = "-r" if (not defined $srcfile);
     282
     283if (defined $machine) {
     284    $cmd = "scp -p -q $cmdopt $remote:$source $target";
     285} else {
     286    $cmd = "cp -p $cmdopt $source $target";
     287}
     288
     289# Now add content if not already there
     290if (defined $srcfile) {
     291    # File case
     292    if ((! -f "$target/$srcfile") || (defined $force)){
     293        if ($debug) {
     294            pb_log(1,"DEBUG: launching $cmd\n");
    804295        } else {
    805             $pbver = $ENV{'PBPROJVER'};
     296            pb_system($cmd);
     297            pb_vcs_add($scheme,"$target/$srcfile");
     298            pb_log(0,"INFO: Created $target/$srcfile and added it to your $scheme system\n");
    806299        }
    807         # If it's a test version, then tag == 0
    808         if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
    809             $pbtag = "0";
    810             $ENV{'PBPROJTAG'} = $pbtag;
    811         } elsif ((defined $pkgt) && (defined $pkgt->{$pbpkg})) {
    812             $pbtag = $pkgt->{$pbpkg};
    813         } else {
    814             $pbtag = $ENV{'PBPROJTAG'};
    815         }
    816 
    817         $pbrev = $ENV{'PBREVISION'};
    818         pb_log(0,"\n");
    819         pb_log(0,"Management of $pbpkg $pbver-$pbtag (rev $pbrev)\n");
    820         die "Unable to get env var PBDESTDIR" if (not defined $ENV{'PBDESTDIR'});
    821 
    822         my $dest = "$ENV{'PBDESTDIR'}/$pbpkg-$pbver$pbextdir";
    823         # Create the structure if needed
    824         pb_mkdir_p($dest);
    825         # Clean up dest if necessary. The export will recreate it
    826         pb_rm_rf($dest) if (-d $dest);
    827 
    828         # Export CMS tree for the concerned package to dest
    829         # And generate some additional files
    830         $OUTPUT_AUTOFLUSH=1;
    831 
    832         # computes in which dir we have to work
    833         my $dir = $defpkgdir->{$pbpkg};
    834         $dir = $extpkgdir->{$pbpkg} if (not defined $dir);
    835         $dir = $webdir->{$ENV{'PBPROJ'}} if (defined $web);
    836         die "Variable \$dir not defined. Please report to dev team with log of a verbose run and this info ".Dumper($webdir) if (not defined $dir);
    837         pb_log(2,"def:".Dumper($defpkgdir)."ext: ".Dumper($extpkgdir)."dir: $dir\n");
    838 
    839         # Exporting content from CMS
    840         my $sourcedir = undef;
    841         my $sourceuri = $uri;
    842         if ($param eq "SandBox") {
    843             # Point to the local instance
    844             $sourcedir = "$ENV{'PBDIR'}/$dir";
    845         } else {
    846             # Get it from a subdir of the URI with same version as localy but different root
    847             # Only if using a real CMS
    848             my ($scheme, $account, $host, $port, $path) = pb_get_uri($uri);
    849             if (($scheme !~ /^file/) && ($scheme !~ /^(ht|f)tp/)) {
    850                 $sourceuri = "$ENV{'PBDIR'}/$dir";
    851                 $sourceuri =~ s|^$ENV{'PBPROJDIR'}/|$uri/|;
    852             }
    853         }
    854         my $preserve = pb_cms_export($sourceuri,$sourcedir,$dest);
    855 
    856         # Generated fake content for test versions to speed up stuff
    857         my $chglog;
    858 
    859         # Get project info on authors and log file
    860         # TODO: Make it CMS aware
    861         $chglog = "$ENV{'PBROOTDIR'}/$pbpkg/pbcl";
    862         $chglog = "$ENV{'PBROOTDIR'}/pbcl" if (! -f $chglog);
    863         $chglog = undef if (! -f $chglog);
    864 
    865         # TODO: Make it CMS aware
    866         my $authors = "$ENV{'PBROOTDIR'}/$pbpkg/pbauthors";
    867         $authors = "$ENV{'PBROOTDIR'}/pbauthors" if (! -f $authors);
    868         $authors = "/dev/null" if (! -f $authors);
    869 
    870         # Extract cms log history and store it
    871         if ((defined $chglog) && (! -f "$dest/NEWS")) {
    872             pb_log(2,"Generating NEWS file from $chglog\n");
    873             copy($chglog,"$dest/NEWS") || die "Unable to create $dest/NEWS";
    874         }
    875         pb_cms_log($scheme,"$ENV{'PBDIR'}/$dir",$dest,$chglog,$authors,$testver);
    876 
    877         my %build;
    878         # We want to at least build for the underlying distro
    879         # except if a target was given, in which case we only build for it
    880         # if -t was passed without target then build for the native distro.
    881         my $pbos = pb_distro_get_context($pbtarget);
    882         my $tmpl = pb_get_distros($pbos,$pbtarget);
    883 
    884         # Setup $pb structure to allow filtering later on, on files using that structure
    885         $pb->{'tag'} = $pbtag;
    886         $pb->{'rev'} = $pbrev;
    887         $pb->{'ver'} = $pbver;
    888         $pb->{'pkg'} = $pbpkg;
    889         $pb->{'suf'} = $pbos->{'suffix'};
    890         $pb->{'realpkg'} = $pbpkg;
    891         $pb->{'date'} = $pbdate;
    892         $pb->{'defpkgdir'} = $defpkgdir;
    893         $pb->{'extpkgdir'} = $extpkgdir;
    894         $pb->{'chglog'} = $chglog;
    895         $pb->{'extdir'} = $pbextdir;
    896         $pb->{'packager'} = $ENV{'PBPACKAGER'};
    897         $pb->{'proj'} = $ENV{'PBPROJ'};
    898         $pb->{'repo'} = "$ENV{'PBREPO'}/$delivery->{$ENV{'PBPROJ'}}";
    899         $pb->{'patches'} = ();
    900         $pb->{'sources'} = ();
    901    
    902         my $tmpd = "$ENV{'PBTMP'}/cms.$$";
    903         pb_mkdir_p($tmpd) if (defined $pbparallel);
    904 
    905         # Get only all.pbf filter at this stage for pbinit
    906         my $ptr = pb_get_filters($pbpkg);
    907 
    908         # Do not do that for website
    909         if (not defined $web) {
    910             my %virt;
    911             # De-duplicate similar VM/VE/RM
    912             foreach my $d (split(/,/,$tmpl)) {
    913                 # skip ill-formatted vms (name-ver-arch)
    914                 next if ($d !~ /-/);
    915                 $virt{$d} = $d;
    916             }
    917 
    918             # Try to use // processing here
    919             my $pm = new Parallel::ForkManager($pbparallel) if (defined $pbparallel);
    920 
    921             pb_log(0,"Preparing delivery ...\n");
    922             foreach my $v (keys %virt) {
    923                 $pm->start and next if (defined $pbparallel);
    924 
    925                 # Distro context
    926                 my $pbos = pb_distro_get_context($v);
    927    
    928                 $pb->{'pbos'} = $pbos;
    929                 $pb->{'suf'} = $pbos->{'suffix'};
    930                 pb_log(3,"DEBUG: pb: ".Dumper($pb)."\n");
    931 
    932                 # Get all filters to apply
    933                 $ptr = pb_get_filters($pbpkg,$pbos);
    934    
    935                 pb_log(2,"DEBUG Filtering PBDATE => $pbdate, PBTAG => $pbtag, PBVER => $pbver\n");
    936    
    937                 # We need to compute the real name of the package
    938                 my $pbrealpkg = pb_cms_get_real_pkg($pbpkg,$pbos->{'type'});
    939                 $pb->{'realpkg'} = $pbrealpkg;
    940                 pb_log(1,"Virtual package $pbpkg has a real package name of $pbrealpkg on $pbos->{'name'}-$pbos->{'version'}\n") if ($pbrealpkg ne $pbpkg);
    941    
    942                 # Filter build files from the less precise up to the most with overloading
    943                 # Filter all files found, keeping the name, and generating in dest
    944    
    945                 # Find all build files first relatively to PBROOTDIR
    946                 # Find also all specific files referenced in the .pb conf file
    947                 my %bfiles = ();
    948                 my %pkgfiles = ();
    949                 # Used in Filter.pm by pb_filter_file
    950 
    951                 $build{$v} = "no";
    952                 if (-d "$ENV{'PBROOTDIR'}/$pbpkg/$pbos->{'os'}") {
    953                     pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$pbos->{'os'}",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
    954                     $build{$v} = "yes";
    955                 }
    956                 if (-d "$ENV{'PBROOTDIR'}/$pbpkg/$pbos->{'type'}") {
    957                     pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$pbos->{'type'}",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
    958                     $build{$v} = "yes";
    959                 }
    960                 if (-d "$ENV{'PBROOTDIR'}/$pbpkg/$pbos->{'family'}") {
    961                     pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$pbos->{'family'}",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
    962                     $build{$v} = "yes";
    963                 }
    964                 if (-d "$ENV{'PBROOTDIR'}/$pbpkg/$pbos->{'name'}") {
    965                     pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$pbos->{'name'}",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
    966                     $build{$v} = "yes";
    967                 }
    968                 if (-d "$ENV{'PBROOTDIR'}/$pbpkg/$pbos->{'name'}-$pbos->{'version'}") {
    969                     pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$pbos->{'name'}-$pbos->{'version'}",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
    970                     $build{$v} = "yes";
    971                 }
    972                 if (-d "$ENV{'PBROOTDIR'}/$pbpkg/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}") {
    973                     pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
    974                     $build{$v} = "yes";
    975                 }
    976                 pb_log(2,"DEBUG($v) bfiles: ".Dumper(\%bfiles)."\n");
    977    
    978                 if ($build{$v} ne "no") {
    979                     # Apply now all the filters on all the files concerned
    980                     # destination dir depends on the type of file
    981                     # For patch support
    982                     # TODO: Make it CMS aware
    983                     $pb->{'patches'} = pb_list_sfiles("$ENV{'PBROOTDIR'}/$pbpkg/pbpatch", $pb->{'patches'}, $pbos, "$ENV{'PBROOTDIR'}/$pbpkg/pbextpatch");
    984                     pb_log(2,"DEBUG($v) patches: ".Dumper($pb->{'patches'})."\n");
    985                     # TODO: Make it CMS aware
    986                     $pb->{'sources'} = pb_list_sfiles("$ENV{'PBROOTDIR'}/$pbpkg/pbsrc", $pb->{'sources'}, $pbos, "$ENV{'PBROOTDIR'}/$pbpkg/pbextsrc");
    987                     pb_log(2,"DEBUG($v) sources: ".Dumper($pb->{'sources'})."\n");
    988    
    989                     if (defined $pb->{'patches'}->{$v}) {
    990                         # Filter potential patches (local + remote)
    991                         pb_mkdir_p("$dest/pbconf/$v/pbpatch");
    992                         # If Debian based distribution, then prepare what will be done at build time
    993                         my ($patchcmd,$patchopt);
    994                         if ($pbos->{'type'} eq "deb") {
    995                             ($patchcmd,$patchopt) = pb_distro_get_param($pbos,pb_conf_get_if("ospatchcmd","ospatchopt"));
    996                             open(SCRIPT,"> $dest/pbconf/$v/pbpatch/pbapplypatch") || die "Unable to create $dest/pbconf/$v/pbpatch/pbapplypatch";
    997                             print SCRIPT "#!/bin/bash\n";
    998                             print SCRIPT "set -x\n" if ($pbdebug gt 1);
    999                         }
    1000                         foreach my $pf (split(/,/,$pb->{'patches'}->{$v})) {
    1001                             my $pp = basename($pf);
    1002                             pb_cms_export($pf,undef,"$dest/pbconf/$v/pbpatch");
    1003                             pb_filter_file_inplace($ptr,"$dest/pbconf/$v/pbpatch/$pp",$pb);
    1004                             pb_system("gzip -9f $dest/pbconf/$v/pbpatch/$pp","","quiet");
    1005                             if ($pbos->{'type'} eq "deb") {
    1006                                 # If Debian based distribution, then prepare what will be done at build time
    1007                                 # by applying the patches that will be available under the debian/patches dir
    1008                                 print SCRIPT "$patchcmd $patchopt \< debian/patches/$pp\n";
    1009                             }
    1010                         }
    1011                         if ($pbos->{'type'} eq "deb") {
    1012                             close(SCRIPT);
    1013                             chmod 0755,"$dest/pbconf/$v/pbpatch/pbapplypatch";
    1014                         }
    1015                         #pb_system("cat $dest/pbconf/$v/pbpatch/pbapplypatch","APPLY","verbose");
    1016                     }
    1017                     if (defined $pb->{'sources'}->{$v}) {
    1018                         pb_mkdir_p("$dest/pbconf/$v/pbsrc");
    1019                         foreach my $pf (split(/,/,$pb->{'sources'}->{$v})) {
    1020                             my $pp = basename($pf);
    1021                             pb_cms_export($pf,undef,"$dest/pbconf/$v/pbsrc");
    1022                             pb_filter_file_inplace($ptr,"$dest/pbconf/$v/pbsrc/$pp",$pb);
    1023                         }
    1024                     }
    1025                     # Filter build files at the end, as they depend on patches and sources
    1026                     foreach my $f (keys %bfiles) {
    1027                         pb_filter_file("$ENV{'PBROOTDIR'}/$bfiles{$f}",$ptr,"$dest/pbconf/$v/$f",$pb);
    1028                     }
    1029                     foreach my $f (keys %pkgfiles) {
    1030                         pb_filter_file("$ENV{'PBROOTDIR'}/$pkgfiles{$f}",$ptr,"$dest/pbconf/$v/$f",$pb);
    1031                     }
    1032                 }
    1033 
    1034                 if (defined $pbparallel) {
    1035                     # Communicate results back to parent
    1036                     my $str = "";
    1037                     $str .= "build $v = $build{$v}\n" if (defined $build{$v});
    1038                     $str .= "patches $v = $pb->{'patches'}->{$v}\n" if (defined $pb->{'patches'}->{$v});
    1039                     $str .= "sources $v = $pb->{'sources'}->{$v}\n" if (defined $pb->{'sources'}->{$v});
    1040                     pb_set_content("$tmpd/$$","$str");
    1041                     $pm->finish;
    1042                 }
    1043             }
    1044             # In the parent, we need to get the result from the children
    1045             $pm->wait_all_children if (defined $pbparallel);
    1046             my $made = "";
    1047             my %h = ();
    1048             my %tmp;
    1049             my %tmp2;
    1050             my $pt;
    1051             my $k;
    1052 
    1053             foreach $k (<$tmpd/*>) {
    1054                 $made .= pb_get_content($k);
    1055             }
    1056             pb_rm_rf($tmpd);
    1057             pb_log(3,"MADE:\n$made");
    1058 
    1059             # Rebuild local hashes
    1060             foreach $k (split(/\n/,$made)) {
    1061                 if ($k =~ /^\s*([A-z0-9-_]+)\s+([[A-z0-9-_.]+)\s*=\s*(.+)$/) {
    1062                     $h{$1}->{$2}=$3;
    1063                 }
    1064             }
    1065             pb_log(2,"HASH: ".Dumper(%h));
    1066 
    1067             # Patches
    1068             pb_log(0,"Delivered and compressed patches ");
    1069             $pt = $h{'patches'};
    1070             foreach $k (keys %$pt) {
    1071                 foreach my $v1 (split(/,/,$pt->{$k})) {
    1072                     $tmp{$v1} = "";
    1073                 }
    1074             }
    1075             if (keys %tmp) {
    1076                 foreach $k (keys %tmp) {
    1077                     pb_log(0,"$k ");
    1078                 }
    1079             } else {
    1080                 pb_log(0,"N/A");
    1081             }
    1082             pb_log(0,"\n");
    1083 
    1084             # Sources
    1085             pb_log(0,"Delivered additional sources ");
    1086             $pt = $h{'sources'};
    1087             foreach $k (keys %$pt) {
    1088                 foreach my $v1 (split(/,/,$pt->{$k})) {
    1089                     $tmp2{$v1} = "";
    1090                 }
    1091             }
    1092             if (keys %tmp2) {
    1093                 foreach $k (keys %tmp2) {
    1094                     pb_log(0,"$k ");
    1095                 }
    1096             } else {
    1097                 pb_log(0,"N/A");
    1098             }
    1099             pb_log(0,"\n");
    1100 
    1101             # Build files
    1102             my @found;
    1103             my @notfound;
    1104             $pt = $h{'build'};
    1105             foreach my $b (keys %$pt) {
    1106                 push @found,$b if ($pt->{$b} =~ /yes/);
    1107                 push @notfound,$b if ($pt->{$b} =~ /no/);
    1108             }
    1109             pb_log(0,"Build files have been generated for ... ".join(',',sort(@found))."\n") if (@found);
    1110             pb_log(0,"No Build files found for ".join(',',sort(@notfound))."\n") if (@notfound);
    1111 
    1112         } else {
    1113             # Instead call News generation
    1114             pb_web_news2html($dest);
    1115             # And create an empty pbconf
    1116             pb_mkdir_p("$dest/pbconf");
    1117             # And prepare the pbscript to execute remotely
    1118             open(SCRIPT,"> $ENV{'PBTMP'}/pbscript") || die "Unable to create $ENV{'PBTMP'}/pbscript";
    1119             print SCRIPT "#!/bin/bash\n";
    1120             print SCRIPT "#set -x\n";
    1121             print SCRIPT "echo ... Extracting Website content\n";
    1122             print SCRIPT "find . -type f | grep -Ev '^./$pbpkg-$pbver$pbextdir.tar.gz|^./pbscript' | xargs rm -f non-existent\n";
    1123             print SCRIPT "find * -type d -depth | xargs rmdir 2> /dev/null \n";
    1124             print SCRIPT "tar xfz $pbpkg-$pbver$pbextdir.tar.gz\n";
    1125             print SCRIPT "mv $pbpkg-$pbver$pbextdir/* .\n";
    1126             print SCRIPT "rm -f $pbpkg-$pbver$pbextdir.tar.gz\n";
    1127             print SCRIPT "rmdir $pbpkg-$pbver$pbextdir\n";
    1128             close(SCRIPT);
    1129             chmod 0755,"$ENV{'PBTMP'}/pbscript";
    1130         }
    1131 
    1132         # Apply filters to the non-build files
    1133         my $liste ="";
    1134         if (defined $filteredfiles->{$pbpkg}) {
    1135             foreach my $f (split(/,/,$filteredfiles->{$pbpkg})) {
    1136                 pb_filter_file_inplace($ptr,"$dest/$f",$pb);
    1137                 $liste = "$f $liste";
    1138             }
    1139         }
    1140         pb_log(2,"Files ".$liste."have been filtered\n");
    1141 
    1142         # TODO: Make it CMS aware
    1143         # Execute the pbinit script if any
    1144         if (-x "$ENV{'PBROOTDIR'}/$pbpkg/pbinit") {
    1145             pb_filter_file("$ENV{'PBROOTDIR'}/$pbpkg/pbinit",$ptr,"$ENV{'PBTMP'}/pbinit",$pb);
    1146             chmod 0755,"$ENV{'PBTMP'}/pbinit";
    1147             pb_system("cd $dest ; $ENV{'PBTMP'}/pbinit","Executing init script from $ENV{'PBROOTDIR'}/$pbpkg/pbinit under $dest","verbose");
    1148         }
    1149 
    1150         # Do we have additional script to run to prepare the environement for the project ?
    1151         # Then include it in the pbconf delivery
    1152         foreach my $pbvf (<$ENV{'PBROOTDIR'}/pbv*.pre>,<$ENV{'PBROOTDIR'}/pbv*.post>, <$ENV{'PBROOTDIR'}/pbtest*>) {
    1153             if (-x "$pbvf") {
    1154                 my $target = "$ENV{'PBDESTDIR'}/".basename($pbvf);
    1155                 pb_filter_file("$pbvf",$ptr,$target,$pb);
    1156                 chmod 0755,"$target";
    1157             }
    1158         }
    1159 
    1160         # Prepare the dest directory for archive
    1161         chdir "$ENV{'PBDESTDIR'}" || die "Unable to change dir to $ENV{'PBDESTDIR'}";
    1162         if (defined $preserve) {
    1163             # In that case we want to preserve the original tar file for checksum purposes
    1164             # The one created is btw equivalent in that case to this one
    1165             # Maybe check basename of both to be sure they are the same ?
    1166             pb_log(0,"Preserving original tar file ");
    1167             move("$preserve","$pbpkg-$pbver$pbextdir.tar.gz");
    1168         } else {
    1169             # Possibility to look at PBSRC to guess more the filename
    1170             pb_system("tar cfz $pbpkg-$pbver$pbextdir.tar.gz --exclude=$pbpkg-$pbver$pbextdir/pbconf $pbpkg-$pbver$pbextdir","Creating $pbpkg tar files compressed");
    1171         }
    1172         pb_log(0,"Under $ENV{'PBDESTDIR'}/$pbpkg-$pbver$pbextdir.tar.gz\n");
    1173         pb_system("tar cfz $pbpkg-$pbver$pbextdir.pbconf.tar.gz $pbpkg-$pbver$pbextdir/pbconf","Creating pbconf tar files compressed");
    1174         pb_log(0,"Under $ENV{'PBDESTDIR'}/$pbpkg-$pbver$pbextdir.pbconf.tar.gz\n");
    1175 
    1176         # Keep track of version-tag per pkg
    1177         $pkgs{$pbpkg} = "$pbver-$pbtag";
    1178 
    1179         # Final cleanup
    1180         pb_rm_rf($dest) if (-d $dest);
    1181     }
    1182 
    1183     # Keep track of per package version
    1184     pb_log(2,"DEBUG pkgs: ".Dumper(%pkgs)."\n");
    1185     open(PKG,"> $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb") || die "Unable to create $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb";
    1186     foreach my $pbpkg (keys %pkgs) {
    1187         print PKG "pbpkg $pbpkg = $pkgs{$pbpkg}\n";
    1188     }
    1189     close(PKG);
    1190 
    1191     # Keep track of what is generated by default
    1192     # We need to store the dir and info on version-tag
    1193     # Base our content on the existing .pb file
    1194     copy("$ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb","$ENV{'PBDESTDIR'}/pbrc");
    1195     open(LAST,">> $ENV{'PBDESTDIR'}/pbrc") || die "Unable to create $ENV{'PBDESTDIR'}/pbrc";
    1196     print LAST "pbroot $ENV{'PBPROJ'} = $ENV{'PBROOTDIR'}\n";
    1197     print LAST "projver $ENV{'PBPROJ'} = $ENV{'PBPROJVER'}\n";
    1198     print LAST "projtag $ENV{'PBPROJ'} = $ENV{'PBPROJTAG'}\n";
    1199     print LAST "pbpackager $ENV{'PBPROJ'} = $ENV{'PBPACKAGER'}\n";
    1200     print LAST "pbextdir $ENV{'PBPROJ'} = $pbextdir\n";
    1201     close(LAST);
    1202 }
    1203 
    1204 sub pb_test2pkg {
    1205     # Get the running distro to test on
    1206     my $pbos = pb_distro_get_context();
    1207 
    1208     # Get list of packages to test
    1209     # Get content saved in cms2build
    1210     my $ptr = pb_get_pkg();
    1211     @pkgs = @$ptr;
    1212 
    1213     # Additional potential repo
    1214     pb_distro_setuprepo($pbos);
    1215     foreach my $pbpkg (@pkgs) {
    1216         # We need to install the package to test, and deps brought with it
    1217         pb_distro_installdeps(undef,$pbos,$pbpkg);
    1218         pb_system("$ENV{'PBDESTDIR'}/pbtest","Launching test for $pbpkg","verbose");
    1219     }
    1220 }
    1221 
    1222 sub pb_build2pkg {
    1223 
    1224     # Get the running distro to build on
    1225     my $pbos = pb_distro_get_context();
    1226 
    1227     # If needed we may add repository to the build env
    1228     pb_distro_setuprepo($pbos);
    1229 
    1230     # Get list of packages to build
    1231     my $ptr = pb_get_pkg();
    1232     @pkgs = @$ptr;
    1233 
    1234     # Get content saved in cms2build
    1235     my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
    1236     $pkg = { } if (not defined $pkg);
    1237     my $pbextdir = pb_get_extdir();
    1238 
    1239     pb_mkdir_p("$ENV{'PBBUILDDIR'}") if (! -d "$ENV{'PBBUILDDIR'}");
    1240     chdir "$ENV{'PBBUILDDIR'}" || die "Unable to chdir to $ENV{'PBBUILDDIR'}";
    1241     my $made = ""; # pkgs made during build
    1242     my $pm;
    1243     $pm = new Parallel::ForkManager($pbparallel) if (defined $pbparallel);
    1244 
    1245     # We need to communicate info back from the children if parallel so prepare a dir for that
    1246     my $tmpd = "$ENV{'PBTMP'}/build.$$";
    1247     pb_mkdir_p($tmpd) if (defined $pbparallel);
    1248 
    1249     foreach my $pbpkg (@pkgs) {
    1250         $pm->start and next if (defined $pbparallel);
    1251 
    1252         my $vertag = $pkg->{$pbpkg};
    1253         pb_log(2,"Vertag: $vertag\n");
    1254         # get the version of the current package - maybe different
    1255         ($pbver,$pbtag) = split(/-/,$vertag);
    1256 
    1257         my $src="$ENV{'PBDESTDIR'}/$pbpkg-$pbver$pbextdir.tar.gz";
    1258         my $src2="$ENV{'PBDESTDIR'}/$pbpkg-$pbver$pbextdir.pbconf.tar.gz";
    1259         pb_log(2,"Source file: $src\n");
    1260         pb_log(2,"Pbconf file: $src2\n");
    1261 
    1262         pb_log(2,"Working directory: $ENV{'PBBUILDDIR'}\n");
    1263         if ($pbos->{'type'} eq "rpm") {
    1264             foreach my $d ('RPMS','SRPMS','SPECS','SOURCES','BUILD') {
    1265                 if (! -d "$ENV{'PBBUILDDIR'}/$d") {
    1266                     pb_mkdir_p("$ENV{'PBBUILDDIR'}/$d");
    1267                 }
    1268             }
    1269 
    1270             # Remove in case a previous link/file was there
    1271             unlink "$ENV{'PBBUILDDIR'}/SOURCES/".basename($src);
    1272             symlink "$src","$ENV{'PBBUILDDIR'}/SOURCES/".basename($src) || die "Unable to symlink $src in $ENV{'PBBUILDDIR'}/SOURCES";
    1273             # We need to first extract the spec file
    1274             my @specfile = pb_extract_build_files($src2,"$pbpkg-$pbver$pbextdir/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/","$ENV{'PBBUILDDIR'}/SPECS","spec");
    1275 
    1276             # We need to handle potential patches to upstream sources
    1277             pb_extract_build_files($src2,"$pbpkg-$pbver$pbextdir/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbpatch/","$ENV{'PBBUILDDIR'}/SOURCES","patch");
    1278 
    1279             # We need to handle potential additional sources to upstream sources
    1280             pb_extract_build_files($src2,"$pbpkg-$pbver$pbextdir/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbsrc/","$ENV{'PBBUILDDIR'}/SOURCES","src");
    1281 
    1282             pb_log(2,"specfile: ".Dumper(\@specfile)."\n");
    1283             # set LANGUAGE to check for correct log messages
    1284             $ENV{'LANGUAGE'}="C";
    1285             # Older Redhat use _target_platform in %configure incorrectly
    1286             my $specialdef = "";
    1287             if (($pbos->{'name'} eq "redhat") || (($pbos->{'name'} eq "rhel") && ($pbos->{'version'} eq "2.1"))) {
    1288                 $specialdef = "--define \'_target_platform \"\"\'";
    1289             }
    1290 
    1291             foreach my $f (@specfile) {
    1292                 if ($f =~ /\.spec$/) {
    1293                     # This could cause an issue in // mode
    1294                     pb_distro_installdeps($f,$pbos);
    1295                     pb_system("rpmbuild $specialdef --define \"packager $ENV{'PBPACKAGER'}\" --define \"_topdir $ENV{'PBBUILDDIR'}\" -ba $f","Building package with $f under $ENV{'PBBUILDDIR'}","verbose");
    1296                     last;
    1297                 }
    1298             }
    1299             # Get the name of the generated packages
    1300             open(LOG,"$ENV{'PBTMP'}/system.$$.log") || die "Unable to open $ENV{'PBTMP'}/system.$$.log";
    1301             while (<LOG>) {
    1302                 chomp($_);
    1303                 next if ($_ !~ /^Wrote:/);
    1304                 s|.*/([S]*RPMS.*)|$1|;
    1305                 $made .=" $_";
    1306             }
    1307             close(LOG);
    1308 
    1309         } elsif ($pbos->{'type'} eq "deb") {
    1310             pb_system("tar xfz $src","Extracting sources");
    1311             pb_system("tar xfz $src2","Extracting pbconf");
    1312 
    1313             chdir "$pbpkg-$pbver$pbextdir" || die "Unable to chdir to $pbpkg-$pbver$pbextdir";
    1314             pb_rm_rf("debian");
    1315             symlink "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}","debian" || die "Unable to symlink to pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}";
    1316             chmod 0755,"debian/rules";
    1317 
    1318             # We need to handle potential patches to upstream sources
    1319             pb_mkdir_p("debian/patches");
    1320             my @f = pb_extract_build_files($src2,"$pbpkg-$pbver$pbextdir/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbpatch/","debian/patches","patch");
    1321 
    1322             # By default we use format 1.0 - Cf man dpkg-source
    1323             my $debsrcfmt = "1.0";
    1324             my $debsrcfile = "debian/source/format";
    1325             if (-f $debsrcfile) {
    1326                 $debsrcfmt = pb_get_content($debsrcfile);
    1327             }
    1328                
    1329             if ($debsrcfmt =~ /^3.*quilt/) {
    1330                 # If we use quilt to manage patches, we then setup the env correctly
    1331                 # as per http://pkg-perl.alioth.debian.org/howto/quilt.html
    1332                 # Generate Debian patch series for quilt
    1333                 open(SERIE,"> debian/patches/series") || die "Unable to write in debian/patches/series";
    1334                 $ENV{'QUILT_PATCHES'}="debian/patches";
    1335             } else {
    1336                 # If we use dpatch to manage patches, we then setup the 00list file as well
    1337                 open(SERIE,"> debian/patches/00list") || die "Unable to write in debian/patches/00list";
    1338             }
    1339             foreach my $f (sort @f) {
    1340                 # Skip the script made to apply the patches to the Debian tree
    1341                 next if ($f =~ /pbapplypatch/);
    1342                 # We also need to uncompress them
    1343                 pb_system("gzip -d $f","","quiet");
    1344                 $f =~ s/\.gz$//;
    1345                 print SERIE "$f\n";
    1346             }
    1347             close(SERIE);
    1348             if (@f) {
    1349                 # We have patches...
    1350                 if ($debsrcfmt =~ /^1.*/) {
    1351                     # In that case we need to apply the patches ourselves locally
    1352                     pb_system("cat debian/patches/pbapplypatch","APPLY","verbose");
    1353                     pb_system("debian/patches/pbapplypatch","Applying patches to $pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'} tree");
    1354                 }
    1355                 # ...so modify the name of files to be Debian compliant
    1356                 move("../$src","../$pbpkg-$pbver$pbextdir.orig.tar.gz");
    1357             }
    1358 
    1359             # We need to handle potential additional sources to upstream sources
    1360             #pb_extract_build_files($src2,"$pbpkg-$pbver$pbextdir/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbsrc/","$ENV{'PBBUILDDIR'}/debian","src");
    1361 
    1362             pb_distro_installdeps("debian/control",$pbos);
    1363             pb_system("dpkg-buildpackage -us -uc -rfakeroot","Building package","verbose");
    1364             # Get the name of the generated packages
    1365             open(LOG,"$ENV{'PBTMP'}/system.$$.log") || die "Unable to open $ENV{'PBTMP'}/system.$$.log";
    1366             while (<LOG>) {
    1367                 chomp();
    1368                 my $tmp = $_;
    1369                 next if ($tmp !~ /^dpkg-deb.*:/);
    1370                 $tmp =~ s|.*\.\./(.*)_(.*).deb.*|$1|;
    1371                 $made="$made $tmp.dsc $tmp.tar.gz $tmp"."_*.deb $tmp"."_*.changes";
    1372             }
    1373             close(LOG);
    1374             chdir ".." || die "Unable to chdir to parent dir";
    1375             pb_rm_rf("$pbpkg-$pbver");
    1376         } elsif ($pbos->{'type'} eq "ebuild") {
    1377             my @ebuildfile;
    1378             # For gentoo we need to take pb as subsystem name
    1379             # We put every apps here under sys-apps. hope it's correct
    1380             # We use pb's home dir in order to have a single OVERLAY line
    1381             my $tmpe = "$ENV{'HOME'}/portage/pb/sys-apps/$pbpkg";
    1382             pb_mkdir_p($tmpe) if (! -d "$tmpe");
    1383             pb_mkdir_p("$ENV{'HOME'}/portage/distfiles") if (! -d "$ENV{'HOME'}/portage/distfiles");
    1384 
    1385             # We need to first extract the ebuild file
    1386             @ebuildfile = pb_extract_build_files($src2,"$pbpkg-$pbver$pbextdir/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/","$tmpe","ebuild");
    1387 
    1388             # Prepare the build env for gentoo
    1389             my $found = 0;
    1390             my $pbbd = $ENV{'HOME'};
    1391             $pbbd =~ s|/|\\/|g;
    1392             if (-r "/etc/make.conf") {
    1393                 open(MAKE,"/etc/make.conf");
    1394                 while (<MAKE>) {
    1395                     $found = 1 if (/$pbbd\/portage/);
    1396                 }
    1397                 close(MAKE);
    1398             }
    1399             if ($found == 0) {
    1400                 pb_system("sudo sh -c 'echo PORTDIR_OVERLAY=\"$ENV{'HOME'}/portage\" >> /etc/make.conf'");
    1401             }
    1402             #$found = 0;
    1403             #if (-r "/etc/portage/package.keywords") {
    1404             #open(KEYW,"/etc/portage/package.keywords");
    1405             #while (<KEYW>) {
    1406             #$found = 1 if (/portage\/pb/);
    1407             #}
    1408             #close(KEYW);
    1409             #}
    1410             #if ($found == 0) {
    1411             #pb_system("sudo sh -c \"echo portage/pb >> /etc/portage/package.keywords\"");
    1412             #}
    1413 
    1414             # Build
    1415             foreach my $f (@ebuildfile) {
    1416                 if ($f =~ /\.ebuild$/) {
    1417                     pb_distro_installdeps($f,$pbos);
    1418                     move($f,"$tmpe/$pbpkg-$pbver.ebuild");
    1419                     pb_system("cd $tmpe ; ebuild $pbpkg-$pbver.ebuild clean ; ebuild $pbpkg-$pbver.ebuild digest ; ebuild $pbpkg-$pbver.ebuild package","verbose");
    1420                     # Now move it where pb expects it
    1421                     pb_mkdir_p("$ENV{'PBBUILDDIR'}/portage/pb/sys-apps/$pbpkg");
    1422                     if ($pbtag eq 0) {
    1423                         # This is assumed to be a test version
    1424                         my $nver = substr($pbver,0,-14);
    1425                         my $ntag = substr($pbver,-14);
    1426                         my $ebtg = "portage/pb/sys-apps/$pbpkg/$pbpkg-$nver"."_p$ntag.ebuild";
    1427                         move("$tmpe/$pbpkg-$pbver.ebuild","$ENV{'PBBUILDDIR'}/$ebtg");
    1428                         $made="$made $ebtg";
    1429                     } else {
    1430                         my $ebtg = "portage/pb/sys-apps/$pbpkg/$pbpkg-$pbver-r$pbtag.ebuild";
    1431                         move("$tmpe/$pbpkg-$pbver.ebuild","$ENV{'PBBUILDDIR'}/$ebtg");
    1432                         $made="$made $ebtg";
    1433                     }
    1434                 }
    1435             }
    1436 
    1437         } elsif ($pbos->{'type'} eq "tgz") {
    1438             # Slackware family
    1439             $made="$made $pbpkg/$pbpkg-$pbver-*-$pbtag.tgz";
    1440 
    1441             pb_system("tar xfz $src","Extracting sources");
    1442             pb_system("tar xfz $src2","Extracting pbconf");
    1443             chdir "$pbpkg-$pbver$pbextdir" || die "Unable to chdir to $pbpkg-$pbver$pbextdir";
    1444             symlink "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}","install" || die "Unable to symlink to pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}";
    1445             if (-x "install/pbslack") {
    1446                 pb_distro_installdeps("./install/pbslack",$pbos);
    1447                 pb_system("./install/pbslack","Building software");
    1448                 pb_system("sudo /sbin/makepkg -p -l y -c y $pbpkg","Packaging $pbpkg","verbose");
    1449             }
    1450             chdir ".." || die "Unable to chdir to parent dir";
    1451             pb_rm_rf("$pbpkg-$pbver$pbextdir");
    1452         } elsif ($pbos->{'type'} eq "pkg") {
    1453             # Solaris
    1454             $made="$made $pbpkg-$pbver-$pbtag.pkg.gz";
    1455             my $pkgdestdir="$ENV{'PBBUILDDIR'}/install";
    1456 
    1457             # Will host resulting packages
    1458             pb_mkdir_p("$pbos->{'type'}");
    1459             pb_mkdir_p("$pkgdestdir/delivery");
    1460             pb_system("tar xfz $src","Extracting sources under $ENV{'PBBUILDDIR'}");
    1461             pb_system("tar xfz $src2","Extracting pbconf under $ENV{'PBBUILDDIR'}");
    1462             # We need to handle potential patches to upstream sources
    1463             pb_extract_build_files($src2,"$pbpkg-$pbver$pbextdir/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbpatch/","$ENV{'PBBUILDDIR'}","patch");
    1464 
    1465             # We need to handle potential additional sources to upstream sources
    1466             pb_extract_build_files($src2,"$pbpkg-$pbver$pbextdir/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbsrc/","$ENV{'PBBUILDDIR'}","src");
    1467 
    1468             chdir "$pbpkg-$pbver$pbextdir" || die "Unable to chdir to $pbpkg-$pbver$pbextdir";
    1469             if (-f "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbbuild") {
    1470                 chmod 0755,"pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbbuild";
    1471                 # pkginfo file is mandatory
    1472                 die "Unable to find pkginfo file in pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}" if (! -f "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pkginfo");
    1473                 # Build
    1474                 pb_system("pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbbuild $pkgdestdir/delivery","Building software and installing under $pkgdestdir/delivery");
    1475                 # Copy complementary files
    1476                 if (-f "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/prototype") {
    1477                     copy("pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/prototype", $pkgdestdir)
    1478                 } else {
    1479                     # No prototype provided, calculating it
    1480                     open(PROTO,"> $pkgdestdir/prototype") || die "Unable to create prototype file";
    1481                     print PROTO "i pkginfo\n";
    1482                     print PROTO "i depend\n" if (-f "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/depend");
    1483                     $ENV{'PBSOLDESTDIR'} = "$pkgdestdir/delivery";
    1484                     find(\&create_solaris_prototype, "$pkgdestdir/delivery");
    1485                 }
    1486                 copy("pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/depend", $pkgdestdir) if (-f "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/depend");
    1487                 copy("pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pkginfo", $pkgdestdir);
    1488                 pb_system("cd $pkgdestdir/delivery ; pkgmk -o -f ../prototype -r $pkgdestdir/delivery -d $ENV{'PBBUILDDIR'}/$pbos->{'type'}","Packaging $pbpkg","verbose");
    1489                 pb_system("cd $ENV{'PBBUILDDIR'}/$pbos->{'type'} ;  echo \"\" | pkgtrans -o -n -s $ENV{'PBBUILDDIR'}/$pbos->{'type'} $ENV{'PBBUILDDIR'}/$pbpkg-$pbver-$pbtag.pkg all","Transforming $pbpkg","verbose");
    1490                 pb_system("cd $ENV{'PBBUILDDIR'} ;  gzip -9f $pbpkg-$pbver-$pbtag.pkg","Compressing $pbpkg-$pbver-$pbtag.pkg","verbose");
    1491             } else {
    1492                 pb_log(0,"No pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbbuild file found for $pbpkg-$pbver in \n");
    1493             }
    1494             chdir ".." || die "Unable to chdir to parent dir";
    1495             pb_rm_rf("$pbpkg-$pbver$pbextdir","$ENV{'PBBUILDDIR'}/$pbos->{'type'}","$pkgdestdir");
    1496         } elsif ($pbos->{'type'} eq "hpux") {
    1497             # HP-UX
    1498             pb_system("tar xfz $src","Extracting sources");
    1499             pb_system("tar xfz $src2","Extracting pbconf");
    1500 
    1501             chdir "$pbpkg-$pbver$pbextdir" || die "Unable to chdir to $pbpkg-$pbver$pbextdir";
    1502             pb_system("buildpackage ","Building package","verbose");
    1503             # Get the name of the generated packages
    1504             open(LOG,"$ENV{'PBTMP'}/system.$$.log") || die "Unable to open $ENV{'PBTMP'}/system.$$.log";
    1505             while (<LOG>) {
    1506                 chomp();
    1507                 my $tmp = $_;
    1508                 next if ($tmp !~ /^SD BUILD.*:/);
    1509                 $tmp =~ s|.*../(.*)_(.*).sd.*|$1|;
    1510                 $made = "$made $tmp"."_*.sd";
    1511             }
    1512             close(LOG);
    1513             $made="$made $pbpkg-$pbver-$pbtag.sd";
    1514 
    1515             chdir ".." || die "Unable to chdir to parent dir";
    1516             pb_rm_rf("$pbpkg-$pbver$pbextdir");
    1517         } else {
    1518             die "Unknown OS type format $pbos->{'type'}";
    1519         }
    1520         if (defined $pbparallel) {
    1521             # Communicate results back to parent
    1522             pb_set_content("$tmpd/$$",$made);
    1523             $pm->finish;
    1524         }
    1525     }
    1526     if (defined $pbparallel) {
    1527         # In the parent, we need to get the result from the children
    1528         $pm->wait_all_children;
    1529         foreach my $f (<$tmpd/*>) {
    1530             $made .= " ".pb_get_content($f);
    1531         }
    1532         pb_rm_rf($tmpd);
    1533     }
    1534 
    1535     # Sign packages
    1536     pb_sign_pkgs($pbos,$made);
    1537 
    1538     # Find the appropriate check cmd/opts
    1539     my ($chkcmd,$chkopt) = pb_distro_get_param($pbos,pb_conf_get_if("oschkcmd","oschkopt"));
    1540 
    1541     # Packages check if needed
    1542     if ($pbos->{'type'} eq "rpm") {
    1543         if ((defined  $chkcmd) && (-x $chkcmd)) {
    1544             my $cmd = "$chkcmd";
    1545             $cmd .= " $chkopt" if (defined $chkopt);
    1546             $cmd .= " $made";
    1547             pb_system("$cmd","Checking validity of rpms with $chkcmd","verbose");
    1548         }
    1549         my $rpms ="";
    1550         my $srpms ="";
    1551         foreach my $f (split(/ /,$made)) {
    1552             $rpms .= "$ENV{'PBBUILDDIR'}/$f " if ($f =~ /^RPMS\//);
    1553             $srpms .= "$ENV{'PBBUILDDIR'}/$f " if ($f =~ /^SRPMS\//);
    1554         }
    1555         pb_log(0,"SRPM packages generated: $srpms\n");
    1556         pb_log(0,"RPM packages generated: $rpms\n");
    1557     } elsif ($pbos->{'type'} eq "deb") {
    1558         my $made2 = "";
    1559         foreach my $f (split(/ /,$made)) {
    1560             $made2 .= "$f " if ($f =~ /\.deb$/);
    1561         }
    1562         if (-x $chkcmd) {
    1563             pb_system("$chkcmd $chkopt $made2","Checking validity of debs with $chkcmd","verbose");
    1564         }
    1565         pb_log(0,"deb packages generated: $made2\n");
    1566     } else {
    1567         pb_log(0,"No check done for $pbos->{'type'} yet\n");
    1568         pb_log(0,"Packages generated: $made\n");
    1569     }
    1570 
    1571     # Keep track of what is generated so that we can get them back from VMs/RMs
    1572     open(KEEP,"> $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}-$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}") || die "Unable to create $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}-$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}";
    1573     print KEEP "$made\n";
    1574     close(KEEP);
    1575 }
    1576 
    1577 sub create_solaris_prototype {
    1578 
    1579     my $uidgid = "bin bin";
    1580     my $pkgdestdir = $ENV{'PBSOLDESTDIR'};
    1581 
    1582     return if ($_ =~ /^$pkgdestdir$/);
    1583     if (-d $_) {
    1584         my $n = $File::Find::name;
    1585         $n =~ s~$pkgdestdir/~~;
    1586         print PROTO "d none $n 0755 $uidgid\n";
    1587     } elsif (-x $_) {
    1588         my $n = $File::Find::name;
    1589         $n =~ s~$pkgdestdir/~~;
    1590         print PROTO "f none $n 0755 $uidgid\n";
    1591     } elsif (-f $_) {
    1592         my $n = $File::Find::name;
    1593         $n =~ s~$pkgdestdir/~~;
    1594         print PROTO "f none $n 0644 $uidgid\n";
    1595     }
    1596 }
    1597 
    1598 sub pb_build2ssh {
    1599     pb_send2target("Sources");
    1600     pb_send2target("CPAN");
    1601 }
    1602 
    1603 sub pb_pkg2ssh {
    1604     pb_send2target("Packages");
    1605 }
    1606 
    1607 # By default deliver to the the public site hosting the
    1608 # ftp structure (or whatever) or a VM/VE/RM
    1609 sub pb_send2target {
    1610 
    1611     my $cmt = shift;
    1612     my $v = shift || undef;
    1613     my $vmexist = shift || 0;           # 0 is FALSE
    1614     my $vmpid = shift || 0;             # 0 is FALSE
    1615     my $snapme = shift || 0;            # 0 is FALSE
    1616 
    1617     pb_log(2,"DEBUG: pb_send2target($cmt,".Dumper($v).",$vmexist,$vmpid)\n");
    1618     my $host = "sshhost";
    1619     my $login = "sshlogin";
    1620     my $dir = "sshdir";
    1621     my $port = "sshport";
    1622     my $conf = "sshconf";
    1623     my $tmout = undef;
    1624     my $path = undef;
    1625     if ($cmt =~ /^VM/) {
    1626         $login = "vmlogin";
    1627         $dir = "pbdefdir";
    1628         # Specific VM
    1629         $tmout = "vmtmout";
    1630         $path = "vmpath";
    1631         $host = "vmhost";
    1632         $port = "vmport";
    1633     } elsif ($cmt =~ /^RM/) {
    1634         $login = "rmlogin";
    1635         $dir = "pbdefdir";
    1636         # Specific RM
    1637         $tmout = "rmtmout";
    1638         $path = "rmpath";
    1639         $host = "rmhost";
    1640         $port = "rmport";
    1641     } elsif ($cmt =~ /^VE/) {
    1642         $login = "velogin";
    1643         $dir = "pbdefdir";
    1644         # Specific VE
    1645         $path = "vepath";
    1646         $conf = "rbsconf";
    1647     } elsif ($cmt eq "Web") {
    1648         $host = "websshhost";
    1649         $login = "websshlogin";
    1650         $dir = "websshdir";
    1651         $port = "websshport";
    1652     } elsif ($cmt eq "CPAN") {
    1653         $host = "cpanpause";
    1654         $login = "";
    1655         $dir = "cpandir";
    1656         $port = "";
    1657     }
    1658     my $cmd = "";
    1659     my $src = "";
    1660     my $cpanpkg = 0;
    1661     my $pbos;
    1662 
    1663     my $pbextdir = pb_get_extdir();
    1664 
    1665     if ($cmt ne "Announce") {
    1666         # Get list of packages to build
    1667         my $ptr = pb_get_pkg();
    1668         @pkgs = @$ptr;
    1669 
    1670         # Get the running distro to consider
    1671         $pbos = pb_distro_get_context($v);
    1672 
    1673         # Get content saved in cms2build
    1674         my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
    1675         $pkg = { } if (not defined $pkg);
    1676 
    1677         pb_mkdir_p("$ENV{'PBBUILDDIR'}") if (! -d "$ENV{'PBBUILDDIR'}");
    1678         chdir "$ENV{'PBBUILDDIR'}" || die "Unable to chdir to $ENV{'PBBUILDDIR'}";
    1679         foreach my $pbpkg (@pkgs) {
    1680             my $vertag = $pkg->{$pbpkg};
    1681             # get the version of the current package - maybe different
    1682             pb_log(2,"Vertag: $vertag\n");
    1683             ($pbver,$pbtag) = split(/-/,$vertag);
    1684 
    1685             if (($cmt eq "Sources") || ($cmt =~ /(V[EM]|RM)build/)) {
    1686                 $src = "$src $ENV{'PBDESTDIR'}/$pbpkg-$pbver$pbextdir.tar.gz $ENV{'PBDESTDIR'}/$pbpkg-$pbver$pbextdir.pbconf.tar.gz";
    1687                 if ($cmd eq "") {
    1688                     $cmd = "ln -sf $pbpkg-$pbver$pbextdir.tar.gz $pbpkg-latest.tar.gz";
    1689                 } else {
    1690                     $cmd = "$cmd ; ln -sf $pbpkg-$pbver$pbextdir.tar.gz $pbpkg-latest.tar.gz";
    1691                 }
    1692             } elsif ($cmt eq "Web") {
    1693                 $src = "$src $ENV{'PBDESTDIR'}/$pbpkg-$pbver$pbextdir.tar.gz"
    1694             }
    1695 
    1696             # Do we have one perl package
    1697             my @nametype = pb_conf_get_if("namingtype");
    1698             my $type = $nametype[0]->{$pbpkg};
    1699             if ((defined $type) && ($type eq "perl")) {
    1700                 $cpanpkg = 1;
    1701             }
    1702         }
    1703         # Adds conf file for availability of conf elements
    1704         pb_conf_add("$ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb");
    1705     }
    1706     my ($rbsconf,$testver,$delivery) = pb_conf_get_if($conf,"testver","delivery");
    1707     if ($cmt =~ /CPAN/) {
    1708         # Do not deliver on Pause if this is a test version
    1709         return if (not defined $testver);
    1710         return if ($testver =~ /true/);
    1711         # Do not deliver on Pause if this is not a perl package
    1712         return if ($cpanpkg == 0);
    1713     }
    1714 
    1715     if ($cmt =~ /(V[EM]|RM)build/) {
    1716         $src="$src $ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb $ENV{'PBETC'} $ENV{'PBDESTDIR'}/pbrc $ENV{'PBDESTDIR'}/pbscript.$$";
    1717     } elsif ($cmt =~ /(V[EM]|RM)Script/) {
    1718         $src="$src $ENV{'PBDESTDIR'}/pbscript.$$";
    1719     } elsif ($cmt =~ /(V[EM]|RM)test/) {
    1720         $src="$src $ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb $ENV{'PBETC'} $ENV{'PBDESTDIR'}/pbrc $ENV{'PBDESTDIR'}/pbscript.$$ $ENV{'PBDESTDIR'}/pbtest";
    1721     } elsif (($cmt eq "Announce") || ($cmt eq "Web") || ($cmt eq "CPAN")) {
    1722         $src="$src $ENV{'PBTMP'}/pbscript";
    1723     } elsif ($cmt eq "Packages") {
    1724         # Get package list from file made during build2pkg
    1725         open(KEEP,"$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}-$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}") || die "Unable to read $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}-$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}";
    1726         $src = <KEEP>;
    1727         chomp($src);
    1728         close(KEEP);
    1729         $src = "$src $ENV{'PBBUILDDIR'}/pbscript.$$";
    1730     }
    1731     if (($cmt eq "Sources") || ($cmt eq "Packages") || ($cmt eq "CPAN")) {
    1732         my ($pbpackager) = pb_conf_get("pbpackager");
    1733         $ENV{'PBPACKAGER'} = $pbpackager->{$ENV{'PBPROJ'}};
    1734         pb_log(0,"Exporting public key for $ENV{'PBPACKAGER'}\n");
    1735         # Using pb_system is not working due to redirection below
    1736         system("gpg --export -a \'$ENV{'PBPACKAGER'}\' > $ENV{'PBDESTDIR'}/$ENV{'PBPROJ'}.pubkey");
    1737         chmod 0644,"$ENV{'PBDESTDIR'}/$ENV{'PBPROJ'}.pubkey";
    1738         $src = "$src $ENV{'PBDESTDIR'}/$ENV{'PBPROJ'}.pubkey";
    1739     }
    1740     # Remove potential leading spaces (cause problem with basename)
    1741     $src =~ s/^ *//;
    1742     my $basesrc = "";
    1743     foreach my $i (split(/ +/,$src)) {
    1744         $basesrc .= " ".basename($i);
    1745     }
    1746 
    1747     pb_log(0,"Sources handled ($cmt): $src\n");
    1748     pb_log(2,"values: ".Dumper(($host,$login,$dir,$port,$tmout,$path,$conf))."\n");
    1749     my ($sshhost,$sshlogin,$sshdir,$sshport) = pb_conf_get($host,$login,$dir,$port);
    1750     # Not mandatory...
    1751     $delivery->{$ENV{'PBPROJ'}} = "" if (not defined $delivery->{$ENV{'PBPROJ'}});
    1752     my ($vtmout,$vepath);
    1753     # ...Except those in virtual context
    1754     if ($cmt =~ /^VE/) {
    1755         ($vepath) = pb_conf_get($path);
    1756     }
    1757     if ($cmt =~ /^(V|R)M/) {
    1758         $vtmout = pb_distro_get_param($pbos,pb_conf_get_if($tmout));
    1759     }
    1760     my $remhost = $sshhost->{$ENV{'PBPROJ'}};
    1761     my $remdir = $sshdir->{$ENV{'PBPROJ'}};
    1762     if ($cmt =~ /^V[EM]|RM/) {
    1763         # In that case our real host is in the xxhost with the OS as key, not project as above
    1764         $remhost = pb_distro_get_param($pbos,$sshhost);
    1765     }
    1766     pb_log(2,"ssh: ".Dumper(($remhost,$sshlogin,$remdir,$sshport,$vepath,$rbsconf))."\n");
    1767     pb_log(2,"ssh: ".Dumper($vtmout)."\n") if (defined $vtmout);
    1768 
    1769     my $mac;
    1770     if ($cmt !~ /^VE/) {
    1771         $mac = "$sshlogin->{$ENV{'PBPROJ'}}\@$remhost";
    1772         # Overwrite account value if passed as parameter
    1773         $mac = "$pbaccount\@$remhost" if (defined $pbaccount);
    1774         pb_log(2, "DEBUG: pbaccount: $pbaccount => mac: $mac\n") if (defined $pbaccount);
    1775     } else {
    1776         # VE
    1777         # Overwrite account value if passed as parameter (typically for setup2v)
    1778         $mac = $sshlogin->{$ENV{'PBPROJ'}};
    1779         $mac = $pbaccount if (defined $pbaccount);
    1780     }
    1781 
    1782     my $tdir;
    1783     my $bdir;
    1784     if (($cmt eq "Sources") || ($cmt =~ /(V[EM]|RM)Script/)) {
    1785         $tdir = "$remdir/$delivery->{$ENV{'PBPROJ'}}/src";
    1786     } elsif ($cmt eq "CPAN") {
    1787         $tdir = "$remdir";
    1788     } elsif ($cmt =~ /(V[EM]|RM)(build|test)/) {
    1789         $tdir = $remdir."/$ENV{'PBPROJ'}/delivery";
    1790         $bdir = $remdir."/$ENV{'PBPROJ'}/build";
    1791         # Remove a potential $ENV{'HOME'} as bdir should be relative to pb's home
    1792         $bdir =~ s|\$ENV.+\}/||;
    1793     } elsif ($cmt eq "Announce") {
    1794         $tdir = "$remdir/$delivery->{$ENV{'PBPROJ'}}";
    1795     } elsif ($cmt eq "Web") {
    1796         $tdir = "$remdir/$delivery->{$ENV{'PBPROJ'}}";
    1797     } elsif ($cmt eq "Packages") {
    1798         if (($pbos->{'type'} eq "rpm") || ($pbos->{'type'} eq "pkg") || ($pbos->{'type'} eq "hpux") || ($pbos->{'type'} eq "tgz")) {
    1799             # put packages under an arch subdir
    1800             $tdir = "$remdir/$delivery->{$ENV{'PBPROJ'}}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}";
    1801         } elsif (($pbos->{'type'} eq "deb") || ($pbos->{'type'} eq "ebuild")) {
    1802             # No need for an arch subdir
    1803             $tdir = "$remdir/$delivery->{$ENV{'PBPROJ'}}/$pbos->{'name'}/$pbos->{'version'}";
    1804         } else {
    1805             die "Please teach the dev team where to deliver ($pbos->{'type'} type of packages\n";
    1806         }
    1807 
    1808         my $repodir = $tdir;
    1809         $repodir =~ s|^$remdir/||;
    1810 
    1811         my ($pbrepo) = pb_conf_get("pbrepo");
    1812 
    1813         # Repository management
    1814         open(PBS,"> $ENV{'PBBUILDDIR'}/pbscript.$$") || die "Unable to create $ENV{'PBBUILDDIR'}/pbscript.$$";
    1815         if ($pbos->{'type'} eq "rpm") {
    1816             my $pbsha = pb_distro_get_param($pbos,pb_conf_get("ossha"));
    1817             # Also make a pbscript to generate yum/urpmi bases
    1818             print PBS << "EOF";
    1819 #!/bin/bash
    1820 # Prepare a script to ease yum setup
    1821 EOF
    1822             print PBS "set -x\n" if ($pbdebug gt 1);
    1823             print PBS << "EOF";
    1824 cat > $ENV{'PBPROJ'}.repo << EOT
    1825 [$ENV{'PBPROJ'}]
    1826 name=$pbos->{'name'} $pbos->{'version'} $pbos->{'arch'} - $ENV{'PBPROJ'} Vanilla Packages
    1827 baseurl=$pbrepo->{$ENV{'PBPROJ'}}/$repodir
    1828 enabled=1
    1829 gpgcheck=1
    1830 gpgkey=$pbrepo->{$ENV{'PBPROJ'}}/$repodir/$ENV{'PBPROJ'}.pubkey
    1831 EOT
    1832 chmod 644 $ENV{'PBPROJ'}.repo
    1833 
    1834 # Clean up old repo content
    1835 rm -rf headers/ repodata/
    1836 # Create yum repo
    1837 if [ -x /usr/bin/yum-arch ]; then
    1838     yum-arch .
    1839 fi
    1840 # Create repodata
    1841 createrepo -s $pbsha .
    1842 # Link to the key
    1843 (cd repodata ; ln -sf ../$ENV{'PBPROJ'}.pubkey repomd.xml.key)
    1844 # sign the repomd (at least useful for SLES - which requires a local key)
    1845 # gpg -a --detach-sign repodata/repomd.xml
    1846 # SLES also looks for media.1/info.txt
    1847 EOF
    1848             if ($pbos->{'family'} eq "md") {
    1849                 # For Mandriva add urpmi management
    1850                 print PBS << "EOF";
    1851 # Prepare a script to ease urpmi setup
    1852 cat > $ENV{'PBPROJ'}.addmedia << EOT
    1853 urpmi.addmedia $ENV{'PBPROJ'} $pbrepo->{$ENV{'PBPROJ'}}/$repodir with media_info/hdlist.cz
    1854 EOT
    1855 chmod 755 $ENV{'PBPROJ'}.addmedia
    1856 
    1857 # Clean up old repo content
    1858 rm -f hdlist.cz synthesis.hdlist.cz
    1859 # Create urpmi repo
    1860 genhdlist2 --clean .
    1861 if [ \$\? -ne 0 ]; then
    1862     genhdlist .
    1863 fi
    1864 EOF
    1865             }
    1866             if ($pbos->{'name'} eq "fedora") {
    1867                 # Extract the spec file to please Fedora maintainers :-(
    1868                 print PBS << "EOF";
    1869 for p in $basesrc; do
    1870     echo \$p | grep -q 'src.rpm'
    1871     if [ \$\? -eq 0 ]; then
    1872         rpm2cpio \$p | cpio -ivdum --quiet '*.spec'
    1873     fi
    1874 done
    1875 EOF
    1876             }
    1877             if ($pbos->{'family'} eq "novell") {
    1878                 # Add ymp scripts for one-click install on SuSE
    1879                 print PBS << "EOF";
    1880 # Prepare a script to ease SuSE one-click install
    1881 # Cf: http://de.opensuse.org/1-Klick-Installation/ISV
    1882 #
    1883 cat > $ENV{'PBPROJ'}.ymp << EOT
    1884 <?xml version="1.0" encoding="utf-8"?>
    1885 <!-- vim: set sw=2 ts=2 ai et: -->
    1886 <metapackage xmlns:os="http://opensuse.org/Standards/One_Click_Install" xmlns="http://opensuse.org/Standards/One_Click_Install">
    1887     <group><!-- The group of software, typically one for project-builder.org -->
    1888         <name>$ENV{'PBPROJ'} Bundle</name> <!-- Name of the software group -->
    1889         <summary>Software bundle for the $ENV{'PBPROJ'} project</summary> <!--This message is shown to the user and should describe the whole bundle -->
    1890         <description>This is the summary of the $ENV{'PBPROJ'} Project
    1891              
    1892             Details are available on a per package basis below
    1893 
    1894         </description><!--This is also shown to the user -->
    1895         <remainSubscribed>false</remainSubscribed> <!-- Don't know what it mean -->
    1896         <repositories><!-- List of needed repositories -->
    1897             <repository>
    1898                 <name>$ENV{'PBPROJ'} Repository</name> <!-- Name of the repository  -->
    1899                 <summary>This repository contains the $ENV{'PBPROJ'} project packages.</summary> <!-- Summary of the repository -->
    1900                 <description>This repository contains the $ENV{'PBPROJ'} project packages.</description><!-- This description is shown to the user -->
    1901                 <url>$pbrepo->{$ENV{'PBPROJ'}}/$repodir</url><!--URL of repository, which is added -->
    1902             </repository>
    1903         </repositories>
    1904         <software><!-- A List of packages, which should be added through the one-click-installation -->
    1905 EOT
    1906 for p in $basesrc; do
    1907     sum=`rpm -q --qf '%{SUMMARY}' \$p`
    1908     name=`rpm -q --qf '%{NAME}' \$p`
    1909     desc=`rpm -q --qf '%{description}' \$p`
    1910     cat >> $ENV{'PBPROJ'}.ymp << EOT
    1911             <item>
    1912                 <name>\$name</name><!-- Name of the package, is shown to the user and used to identify the package at the repository -->
    1913                 <summary>\$sum</summary> <!-- Summary of the package -->
    1914                 <description>\$desc</description> <!-- Description, is shown to the user -->
    1915             </item>
    1916 EOT
    1917 done
    1918 cat >> $ENV{'PBPROJ'}.ymp << EOT
    1919         </software>
    1920     </group>
    1921 </metapackage>
    1922 EOT
    1923 chmod 644 $ENV{'PBPROJ'}.ymp
    1924 EOF
    1925             }
    1926         } elsif ($pbos->{'type'} eq "deb") {
    1927             # Also make a pbscript to generate apt bases
    1928             # Cf: http://www.debian.org/doc/manuals/repository-howto/repository-howto.fr.html
    1929             # This dirname removes ver
    1930             my $debarch = $pbos->{'arch'};
    1931             $debarch = "amd64" if ($pbos->{'arch'} eq "x86_64");
    1932             my $rpd = dirname("$pbrepo->{$ENV{'PBPROJ'}}/$repodir");
    1933             # Remove extra . in path to fix #522
    1934             $rpd =~ s|/./|/|g;
    1935             print PBS << "EOF";
    1936 #!/bin/bash
    1937 # Prepare a script to ease apt setup
    1938 cat > $ENV{'PBPROJ'}.sources.list << EOT
    1939 deb $rpd $pbos->{'version'} contrib
    1940 deb-src $rpd $pbos->{'version'} contrib
    1941 EOT
    1942 chmod 644 $ENV{'PBPROJ'}.sources.list
    1943 
    1944 # Up two levels to deal with the dist dir cross versions
    1945 cd ..
    1946 mkdir -p dists/$pbos->{'version'}/contrib/binary-$debarch dists/$pbos->{'version'}/contrib/source
    1947 
    1948 # Prepare a script to create apt info file
    1949 # Reuse twice after
    1950 TMPD=`mktemp -d /tmp/pb.XXXXXXXXXX` || exit 1
    1951 mkdir -p \$TMPD
    1952 cat > \$TMPD/Release << EOT
    1953 Archive: unstable
    1954 Component: contrib
    1955 Origin: $ENV{'PBPROJ'}
    1956 Label: $ENV{'PBPROJ'} dev repository $pbrepo->{$ENV{'PBPROJ'}}
    1957 EOT
    1958 
    1959 echo "Creating Packages metadata ($pbos->{'arch'} aka $debarch)"
    1960 dpkg-scanpackages -a$debarch $pbos->{'version'} /dev/null | gzip -c9 > dists/$pbos->{'version'}/contrib/binary-$debarch/Packages.gz
    1961 dpkg-scanpackages -a$debarch $pbos->{'version'} /dev/null | bzip2 -c9 > dists/$pbos->{'version'}/contrib/binary-$debarch/Packages.bz2
    1962 echo "Creating Contents metadata"
    1963 apt-ftparchive contents $pbos->{'version'} | gzip -c9 > dists/$pbos->{'version'}/Contents.gz
    1964 echo "Creating Release metadata ($pbos->{'arch'} aka $debarch)"
    1965 cat \$TMPD/Release > dists/$pbos->{'version'}/contrib/binary-$debarch/Release
    1966 echo "Architecture: $debarch" >> dists/$pbos->{'version'}/contrib/binary-$debarch/Release
    1967 echo "Creating Source metadata"
    1968 dpkg-scansources $pbos->{'version'} /dev/null | gzip -c9 > dists/$pbos->{'version'}/contrib/source/Sources.gz
    1969 cat \$TMPD/Release > dists/$pbos->{'version'}/contrib/source/Release
    1970 echo "Architecture: Source" >> dists/$pbos->{'version'}/contrib/source/Release
    1971 echo "Creating Release metadata"
    1972 # Signing that file would be useful but uneasy as gpg keys are not there
    1973 # Cf: http://wiki.debian.org/SecureApt
    1974 # Same as for repomd
    1975 apt-ftparchive release dists/$pbos->{'version'} > dists/$pbos->{'version'}/Release
    1976 rm -rf \$TMPD
    1977 EOF
    1978         } elsif ($pbos->{'type'} eq "ebuild") {
    1979             # make a pbscript to generate links to latest version
    1980             print PBS << "EOF";
    1981 #!/bin/bash
    1982 # Prepare a script to create correct links
    1983 for p in $src; do
    1984     echo \$p | grep -q '.ebuild'
    1985     if [ \$\? -eq 0 ]; then
    1986         j=`basename \$p`
    1987         pp=`echo \$j | cut -d'-' -f1`
    1988         ln -sf \$j \$pp.ebuild
    1989     fi
    1990 done
    1991 EOF
    1992         }
    1993         close(PBS);
    1994         chmod 0755,"$ENV{'PBBUILDDIR'}/pbscript.$$";
    1995     } else {
    1996         return;
    1997     }
    1998 
    1999     # Useless for VE
    2000     my $nport = pb_get_port($sshport,$pbos,$cmt) if ($cmt !~ /^VE/);
    2001 
    2002     # Remove a potential $ENV{'HOME'} as tdir should be relative to pb's home
    2003     $tdir =~ s|\$ENV.+\}/||;
    2004 
    2005     my $tm = "";
    2006     if ($cmt =~ /^(V|R)M/) {
    2007         $tm = "sleep $vtmout" if (defined $vtmout);
    2008     }
    2009 
    2010     # ssh communication if not VE or CPAN
    2011     # should use a hash instead...
    2012     my ($shcmd,$cpcmd,$cptarget,$cp2target);
    2013     if ($cmt =~ /^VE/) {
    2014         my $tp = $vepath->{$ENV{'PBPROJ'}};
    2015         my $tpdir = "$tp/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}";
    2016         my ($ptr) = pb_conf_get("vetype");
    2017         my $vetype = $ptr->{$ENV{'PBPROJ'}};
    2018         if ($vetype eq "chroot") {
    2019             $shcmd = "sudo /usr/sbin/chroot $tpdir /bin/su - $mac -c ";
    2020         } elsif ($vetype eq "schroot") {
    2021             $shcmd = "schroot $tp -u $mac -- ";
    2022         }
    2023         $cpcmd = "sudo /bin/cp -r ";
    2024         # We need to get the home dir of the target account to deliver in the right place
    2025         open(PASS,"$tpdir/etc/passwd") || die "Unable to open $tpdir/etc/passwd";
    2026         my $homedir = "";
    2027         while (<PASS>) {
    2028             my ($c1,$c2,$c3,$c4,$c5,$c6,$c7) = split(/:/);
    2029             $homedir = $c6 if ($c1 =~ /^$mac$/);
    2030             pb_log(3,"Homedir: $homedir - account: $c6\n");
    2031         }
    2032         close(PASS);
    2033         $cptarget = "$tpdir/$homedir/$tdir";
    2034         if ($cmt eq "VEbuild") {
    2035             $cp2target = "$tpdir/$homedir/$bdir";
    2036         }
    2037         pb_log(2,"On VE using $cptarget as target dir to copy to\n");
    2038     } elsif ($cmt =~ /^CPAN/) {
    2039         my $ftpput = pb_check_req("ncftpput",1);
    2040         my $ftpget = pb_check_req("wget",1);
    2041         my ($cpanuser,$cpanpasswd) = pb_conf_get("cpanuser","cpanpasswd");
    2042         my ($cpansubdir) = pb_conf_get_if("cpansubdir");
    2043         $shcmd = "$ftpget --post-data \'HIDDENNAME=".$cpanuser;
    2044         $shcmd .= "&user=".$cpanuser;
    2045         $shcmd .= "&password=".$cpanpasswd;
    2046         $shcmd .= "&SUBMIT_pause99_add_uri_upload=\"Upload the checked files\"";
    2047         $shcmd .= "&pause99_add_uri_subdirtext=".$cpansubdir if (defined $cpansubdir);
    2048         foreach my $s (split(/ /,$src)) {
    2049             $shcmd .= "&pause99_add_uri_upload=".basename($s);
    2050         }
    2051         $shcmd .= "'";
    2052         $cpcmd = "$ftpput $host $dir";
    2053         $cptarget = "CPAN";
    2054     } else {
    2055         my $keyfile = pb_ssh_get(0);
    2056         my $sshcmd = pb_check_req("ssh",1);
    2057         my $scpcmd = pb_check_req("scp",1);
    2058         $shcmd = "$sshcmd -i $keyfile -q -o UserKnownHostsFile=/dev/null -p $nport $mac";
    2059         $cpcmd = "$scpcmd -i $keyfile -p -o UserKnownHostsFile=/dev/null -P $nport";
    2060         $cptarget = "$mac:$tdir";
    2061         if ($cmt =~ /^(V|R)Mbuild/) {
    2062             $cp2target = "$mac:$bdir";
    2063         }
    2064     }
    2065    
    2066     my $logres = "";
    2067     # Do not touch when just announcing
    2068     if (($cmt ne "Announce") && ($cmt ne "CPAN")) {
    2069         pb_system("$shcmd \"mkdir -p $tdir ; cd $tdir ; echo \'for i in $basesrc; do if [ -f \$i ]; then rm -f \$i; fi; done\ ; $cmd' | bash\"","Preparing $tdir on $cptarget");
    2070     } else {
    2071         $logres = "> ";
    2072     }
    2073     pb_system("cd $ENV{'PBBUILDDIR'} ; $cpcmd $src $cptarget 2> /dev/null","$cmt delivery in $cptarget");
    2074 
    2075     # For VE we need to change the owner manually
    2076     if ($cmt =~ /^VE/) {
    2077         pb_system("$shcmd \"sudo chown -R $mac $tdir\"","Adapt owner in $tdir to $mac");
    2078     }
    2079 
    2080     # Use the right script name depending on context
    2081     my $pbscript;
    2082     if (($cmt =~ /^(V[EM]|RM)/) || ($cmt =~ /Packages/)){
    2083         $pbscript = "pbscript.$$";
    2084     } else {
    2085         $pbscript = "pbscript";
    2086     }
    2087 
    2088     # It's already ready for CPAN
    2089     my $shcmdbase = $shcmd;
    2090     if ($cmt !~ /^CPAN/) {
    2091         $shcmd .= " \"echo \'cd $tdir ; if [ -x $pbscript ]; then ./$pbscript; fi ; rm -f ./$pbscript\' | bash\"";
    2092     }
    2093     my $cmdverb = "verbose";
    2094     if (($cmt eq "Announce") || ($cmt eq "CPAN")) {
    2095         $cmdverb = undef;
    2096     }
    2097     pb_system("$shcmd","Executing pbscript on $cptarget if needed",$cmdverb);
    2098     if ($cmt =~ /^(V[EM]|RM)build/) {
    2099         # Get back info on pkg produced, compute their name and get them from the VM/RM
    2100         pb_system("$cpcmd $cp2target/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}-$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'} $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$ 2> /dev/null","Get package names in $cp2target");
    2101         # For VE we need to change the owner manually
    2102         if ($cmt eq "VEbuild") {
    2103             pb_system("sudo chown $UID $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$","Adapt owner in $tdir to $UID");
    2104         }
    2105         if (not -f "$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$") {
    2106             pb_log(0,"Problem with VM/RM $v on $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$");
    2107         } else {
    2108             open(KEEP,"$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$") || die "Unable to read $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$";
    2109             my $src = <KEEP>;
    2110             chomp($src);
    2111             close(KEEP);
    2112             unlink("$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$");
    2113 
    2114             $src =~ s/^ *//;
    2115             pb_mkdir_p("$ENV{'PBBUILDDIR'}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}");
    2116             # Change pgben to make the next send2target happy
    2117             my $made = "";
    2118    
    2119             # For VM/RM we don't want shell expansion to hapen locally but remotely
    2120             my $delim = '\'';
    2121             if ($cmt =~ /^VEbuild/) {
    2122                 # For VE we need to support shell expansion locally
    2123                 $delim = "";
    2124             }   
    2125 
    2126             open(KEEP,"> $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}-$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}") || die "Unable to write $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}-$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}";
    2127             foreach my $p (split(/ +/,$src)) {
    2128                 my $j = basename($p);
    2129                 pb_system("$cpcmd $cp2target/$delim$p$delim $ENV{'PBBUILDDIR'}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'} 2> /dev/null","Recovery of package $j in $ENV{'PBBUILDDIR'}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}");
    2130                 $made="$made $pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}/$j"; # if (($pbos->{'type'} ne "rpm") || ($j !~ /.src.rpm$/));
    2131             }
    2132             print KEEP "$made\n";
    2133             close(KEEP);
    2134             pb_system("$shcmdbase \"rm -rf $tdir $bdir\"","$cmt cleanup");
    2135 
    2136             # Sign packages locally
    2137             pb_sign_pkgs($pbos,$made);
    2138 
    2139             # We want to send them to the ssh account so overwrite what has been done before
    2140             undef $pbaccount;
    2141             pb_log(2,"Before sending pkgs, vmexist: $vmexist, vmpid: $vmpid\n");
    2142             pb_send2target("Packages",$pbos->{'name'}."-".$pbos->{'version'}."-".$pbos->{'arch'},$vmexist,$vmpid);
    2143             pb_rm_rf("$ENV{'PBBUILDDIR'}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}");
    2144         }
    2145     }
    2146     unlink("$ENV{'PBDESTDIR'}/pbscript.$$") if ((($cmt =~ /^(V[ME]|RM)/) || ($cmt =~ /Packages/)) && ($pbkeep eq 0));
    2147 
    2148     pb_log(2,"Before halt, vmexist: $vmexist, vmpid: $vmpid\n");
    2149     if ((! $vmexist) && ($cmt =~ /^VM/)) {
    2150         # If in setupvm then takes a snapshot just before halting
    2151         if ($snapme != 0) {
    2152             my ($vmmonport,$vmtype) = pb_conf_get("vmmonport","vmtype");
    2153             # For monitoring control
    2154             if ((($vmtype->{$ENV{'PBPROJ'}}) eq "kvm") || (($vmtype->{$ENV{'PBPROJ'}}) eq "qemu")) {
    2155                 eval
    2156                 {
    2157                 require Net::Telnet;
    2158                 Net::Telnet->import();
    2159                 };
    2160                 if ($@) {
    2161                     # Net::Telnet not found
    2162                     pb_log(1,"ADVISE: Install Net::Telnet to benefit from monitoring control and snapshot feature.\nWARNING: No snapshot created");
    2163                 } else {
    2164                     my $t = new Net::Telnet (Timeout => 120, Host => "localhost", Port => $vmmonport->{$ENV{'PBPROJ'}}) || die "Unable to dialog on the monitor";
    2165                     # move to monitor mode
    2166                     my @lines = $t->cmd("c");
    2167                     # Create a snapshot named pb
    2168                     @lines = $t->cmd("savevm pb");
    2169                     # Write the new status in the VM
    2170                     @lines = $t->cmd("commit all");
    2171                     # End
    2172                     @lines = $t->cmd("quit");
    2173                 }
    2174             }
    2175         }
    2176         my $hoption = "-p";
    2177         my $hpath = pb_distro_get_param($pbos,pb_conf_get("ospathcmd-halt"));
    2178         # Solaris doesn't support -p of halt
    2179         if ($pbos->{'type'} eq "pkg") {
    2180             $hoption = "" ;
    2181         }
    2182         pb_system("$shcmdbase \"sudo $hpath $hoption \"; $tm ; echo \'if [ -d /proc/$vmpid ]; then kill -9 $vmpid; fi \' | bash ; sleep 10","VM $v halt (pid $vmpid)");
    2183     }
    2184     if (($cmt =~ /^VE/) && ($snapme != 0)) {
    2185         my $tpdir = "$vepath->{$ENV{'PBPROJ'}}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}";
    2186         pb_system("sudo tar cz -C $tpdir -f $vepath->{$ENV{'PBPROJ'}}/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}.tar.gz .","Creating a snapshot of $tpdir");
    2187     }
    2188 }
    2189 
    2190 sub pb_script2v {
    2191     my $pbscript=shift;
    2192     my $vtype=shift;
    2193     my $pbforce=shift || 0; # Force stop of VM. Default not.
    2194     my $vm1=shift || undef; # Only that VM/VE/RM to treat. Default all.
    2195     my $snapme=shift || 0;  # Do we have to create a snapshot. Default not.
    2196     my $vm;
    2197     my $all;
    2198 
    2199     pb_log(2,"DEBUG: pb_script2v($pbscript,$vtype,$pbforce,".Dumper($vm1).",$snapme)\n");
    2200     # Prepare the script to be executed on the VM/VE/RM
    2201     # in $ENV{'PBDESTDIR'}/pbscript.$$
    2202     if ((defined $pbscript ) && ($pbscript ne "$ENV{'PBDESTDIR'}/pbscript.$$")) {
    2203         copy($pbscript,"$ENV{'PBDESTDIR'}/pbscript.$$") || die "Unable to create $ENV{'PBDESTDIR'}/pbscript.$$";
    2204         chmod 0755,"$ENV{'PBDESTDIR'}/pbscript.$$";
    2205     }
    2206 
    2207     if (not defined $vm1) {
    2208         ($vm,$all) = pb_get2v($vtype);
    2209     } else {
    2210         @$vm = ($vm1);
    2211     }
    2212     my ($vmexist,$vmpid) = (undef,undef);
    2213 
    2214     foreach my $v (@$vm) {
    2215         # Launch VM/VE
    2216         ($vmexist,$vmpid) = pb_launchv($vtype,$v,0,$snapme,$pbsnap);
    2217 
    2218         if ($vtype eq "vm") {
    2219             pb_log(2,"DEBUG: After pb_launchv, vmexist: $vmexist, vmpid: $vmpid\n");
    2220 
    2221             # Skip that VM/RM if something went wrong
    2222             next if (($vmpid == 0) && ($vmexist == 0));
    2223 
    2224             # If force stopping the VM then reset vmexist
    2225             if ($pbforce == 1) {
    2226                 $vmpid = $vmexist;
    2227                 $vmexist = 0;
    2228             }
    2229         } else {
    2230             #VE
    2231             $vmexist = 0;
    2232             $vmpid = 0;
    2233         }
    2234 
    2235         # Gather all required files to send them to the VM/VE/RM
    2236         # and launch the build through pbscript
    2237         pb_log(2,"DEBUG: Before send2target, vmexist: $vmexist, vmpid: $vmpid\n");
    2238         pb_send2target(uc($vtype)."Script","$v",$vmexist,$vmpid,$snapme);
    2239 
    2240     }
    2241 }
    2242 
    2243 sub pb_launchv {
    2244     my $vtype = shift;
    2245     my $v = shift;
    2246     my $create = shift || 0;        # By default do not create a VM/VE/RM
    2247     my $snapme = shift || 0;        # By default do not snap a VM/VE/RM
    2248     my $usesnap = shift || 1;       # By default study the usage of the snapshot feature of VM/VE/RM   
    2249 
    2250     # If creation or snapshot creation mode, no snapshot usable
    2251     if (($create == 1) || ($snapme == 1)) {
    2252         $usesnap = 0;
    2253     }
    2254 
    2255     pb_log(2,"DEBUG: pb_launchv($vtype,$v,$create,$snapme,$usesnap)\n");
    2256     die "No VM/VE/RM defined, unable to launch" if (not defined $v);
    2257     # Keep only the first VM in case many were given
    2258     $v =~ s/,.*//;
    2259 
    2260     my $pbos = pb_distro_get_context($v);
    2261    
    2262     # Launch the VMs/VEs
    2263     if ($vtype eq "vm") {
    2264         die "-i iso parameter needed" if (((not defined $iso) || ($iso eq "")) && ($create != 0));
    2265 
    2266         # TODO: vmmonport should be optional
    2267         my ($ptr,$ptr2,$vmpath,$vmport,$vms,$vmmonport) = pb_conf_get("vmtype","vmcmd","vmpath","vmport","vmsize","vmmonport");
    2268         my ($vmopt,$vmmm,$vmtmout,$vmsnap,$vmbuildtm) = pb_conf_get_if("vmopt","vmmem","vmtmout","vmsnap","vmbuildtm");
    2269         my $vmsize = pb_distro_get_param($pbos,$vms);
    2270 
    2271         my $vmtype = $ptr->{$ENV{'PBPROJ'}};
    2272         my $vmcmd = $ptr2->{$ENV{'PBPROJ'}};
    2273 
    2274         if (defined $opts{'g'}) {
    2275             if (($vmtype eq "kvm") || ($vmtype eq "qemu")) {
    2276                 $ENV{'PBVMOPT'} = "--nographic";
    2277             }
    2278         }
    2279         if (not defined $ENV{'PBVMOPT'}) {
    2280             $ENV{'PBVMOPT'} = "";
    2281         }
    2282         # Save the current status for later restoration
    2283         $ENV{'PBOLDVMOPT'} = $ENV{'PBVMOPT'};
    2284         # Set a default timeout of 2 minutes
    2285         if (not defined $ENV{'PBVMTMOUT'}) {
    2286             $ENV{'PBVMTMOUT'} = "120";
    2287         }
    2288         if (defined $vmopt->{$v}) {
    2289             $ENV{'PBVMOPT'} .= " $vmopt->{$v}" if ($ENV{'PBVMOPT'} !~ / $vmopt->{$v}/);
    2290         } elsif (defined $vmopt->{$ENV{'PBPROJ'}}) {
    2291             $ENV{'PBVMOPT'} .= " $vmopt->{$ENV{'PBPROJ'}}" if ($ENV{'PBVMOPT'} !~ / $vmopt->{$ENV{'PBPROJ'}}/);
    2292         }
    2293 
    2294         # How much memory to allocate for VMs
    2295         my $vmmem = pb_distro_get_param($pbos,$vmmm);
    2296         if (defined $vmmem) {
    2297             $ENV{'PBVMOPT'} .= " -m $vmmem";
    2298         }
    2299 
    2300         # Are we allowed to use snapshot feature
    2301         if ($usesnap == 1) {
    2302             if ((defined $vmsnap->{$v}) && ($vmsnap->{$v} =~ /true/i)) {
    2303                 $ENV{'PBVMOPT'} .= " -snapshot";
    2304             } elsif ((defined $vmsnap->{$ENV{'PBPROJ'}}) && ($vmsnap->{$ENV{'PBPROJ'}} =~ /true/i)) {
    2305                 $ENV{'PBVMOPT'} .= " -snapshot";
    2306             } elsif ($pbsnap eq 1) {
    2307                 $ENV{'PBVMOPT'} .= " -snapshot";
    2308             }
    2309         }
    2310         if ($snapme != 0) {
    2311             if (($vmtype eq "kvm") || ($vmtype eq "qemu")) {
    2312                 # Configure the monitoring to automate the creation of the 'pb' snapshot
    2313                 $ENV{'PBVMOPT'} .= " -serial mon:telnet::$vmmonport->{$ENV{'PBPROJ'}},server,nowait";
    2314                 # In that case no snapshot call needed
    2315                 $ENV{'PBVMOPT'} =~ s/ -snapshot//;
    2316             }
    2317         }
    2318         if (defined $vmtmout->{$v}) {
    2319             $ENV{'PBVMTMOUT'} = $vmtmout->{$v};
    2320         } elsif (defined $vmtmout->{$ENV{'PBPROJ'}}) {
    2321             $ENV{'PBVMTMOUT'} = $vmtmout->{$ENV{'PBPROJ'}};
    2322         }
    2323         my $nport = pb_get_port($vmport,$pbos,$vtype);
    2324    
    2325         my $cmd;
    2326         my $vmm;        # has to be used for pb_check_ps
    2327         if (($vmtype eq "qemu") || ($vmtype eq "kvm")) {
    2328             $vmm = "$vmpath->{$ENV{'PBPROJ'}}/$v.qemu";
    2329             if (($create != 0) || (defined $iso)) {
    2330                 $ENV{'PBVMOPT'} .= " -cdrom $iso -boot d";
    2331             }
    2332             # Always redirect the network and always try to use a 'pb' snapshot
    2333             #$cmd = "$vmcmd $ENV{'PBVMOPT'} -net user,hostfwd=tcp:$nport:10.0.2.15:22 -loadvm pb $vmm"
    2334             $cmd = "$vmcmd $ENV{'PBVMOPT'} -redir tcp:$nport:10.0.2.15:22 $vmm"
    2335         } elsif ($vmtype eq "xen") {
    2336         } elsif ($vmtype eq "vmware") {
    2337         } else {
    2338             die "VM of type $vmtype not supported. Report to the dev team";
    2339         }
    2340         # Restore the ENV VAR Value
    2341         $ENV{'PBVMOPT'} = $ENV{'PBOLDVMOPT'};
    2342 
    2343         my ($tmpcmd,$void) = split(/ +/,$cmd);
    2344         my $vmexist = pb_check_ps($tmpcmd,$vmm);
    2345         my $vmpid = 0;
    2346         if (! $vmexist) {
    2347             if ($create != 0) {
    2348                 die("Found an existing Virtual machine $vmm. Won't overwrite") if (-r $vmm);
    2349                 if (($vmtype eq "qemu") || ($vmtype eq "xen") || ($vmtype eq "kvm")) {
    2350                     my $command = pb_check_req("qemu-img",0);
    2351                     pb_system("$command create -f qcow2 $vmm $vmsize","Creating the QEMU VM");
    2352                 } elsif ($vmtype eq "vmware") {
    2353                 } else {
    2354                 }
    2355             }
    2356             if (! -f "$vmm") {
    2357                 pb_log(0,"Unable to find VM $vmm\n");
    2358             } else {
    2359                 # Is the SSH port free? if not kill the existing process using it after a build timeout period
    2360                 my $vmssh = pb_check_ps($tmpcmd,"tcp:$nport:10.0.2.15:22");
    2361                 if ($vmssh) {
    2362                     my $buildtm = $ENV{'PBVMTMOUT'};
    2363                     if (defined $vmbuildtm->{$v}) {
    2364                         $buildtm = $vmbuildtm->{$v};
    2365                     } elsif (defined $vmbuildtm->{$ENV{'PBPROJ'}}) {
    2366                         $buildtm = $vmbuildtm->{$ENV{'PBPROJ'}};
    2367                     }
    2368 
    2369                     sleep $buildtm;
    2370                     pb_log(0,"WARNING: Killing the process ($vmssh) using port $nport (previous failed VM ?)\n");
    2371                     kill 15,$vmssh;
    2372                     # Let it time to exit
    2373                     sleep 5;
    2374                 }
    2375                 pb_system("$cmd &","Launching the VM $vmm");
    2376                 # Using system allows to kill it externaly if needed
    2377                 pb_system("sleep $ENV{'PBVMTMOUT'}","Waiting $ENV{'PBVMTMOUT'} s for VM $v to come up");
    2378                 $vmpid = pb_check_ps($tmpcmd,$vmm);
    2379                 pb_log(0,"VM $vmm launched (pid $vmpid)\n");
    2380             }
    2381         } else {
    2382             pb_log(0,"Found an existing VM $vmm (pid $vmexist)\n");
    2383         }
    2384         pb_log(2,"DEBUG: pb_launchv returns ($vmexist,$vmpid)\n");
    2385         return($vmexist,$vmpid);
    2386     } elsif ($vtype eq "ve") {
    2387         # Force the creation of the VE and no snapshot usable
    2388         pb_ve_launch($v,$create,$usesnap);
    2389     } else {
    2390         # RM here
    2391         # Get distro context
    2392         my $pbos = pb_distro_get_context($v);
    2393 
    2394         # Get RM context
    2395         my ($ptr,$rmpath) = pb_conf_get("rmtype","rmpath");
    2396 
    2397         # Nothing more to do for RM. No real launch
    2398         # For the moment we support the RM is already running
    2399         # For ProLiant may be able to power them on if needed later on as an example.
    2400     }
    2401 }
    2402 
    2403 # Return string for date synchro
    2404 sub pb_date2v {
    2405 
    2406 my $vtype = shift;
    2407 my $pbos = shift;
    2408 
    2409 my ($ntp) = pb_conf_get_if($vtype."ntp");
    2410 my $vntp = $ntp->{$ENV{'PBPROJ'}} if (defined $ntp);
    2411 my $ntpline = undef;
    2412 
    2413 if (defined $vntp) {
    2414     # ntp command depends on pbos
    2415     my $vntpcmd = pb_distro_get_param($pbos,pb_conf_get($vtype."ntpcmd"));
    2416     $ntpline = "sudo $vntpcmd $vntp";
    2417 }
    2418 # Force new date to be in the future compared to the date
    2419 # of the host by adding 1 minute
    2420 my @date=pb_get_date();
    2421 $date[1]++;
    2422 my $upddate = strftime("%m%d%H%M%Y", @date);
    2423 my $dateline = "sudo /bin/date $upddate";
    2424 if (defined $ntpline) {
    2425     return($ntpline);
     300    } else {
     301        pb_log(0,"INFO: File $target/$srcfile already there\n");
     302    }
    2426303} else {
    2427     return($dateline);
    2428 }
    2429 }
    2430 
    2431 sub pb_build2v {
    2432 
    2433 my $vtype = shift;
    2434 my $action = shift || "build";
    2435 
    2436 my ($v,$all) = pb_get2v($vtype);
    2437 
    2438 # Send tar files when we do a global generation
    2439 pb_build2ssh() if (($all == 1) && ($action eq "build"));
    2440 
    2441 # Adapt // mode to memory size
    2442 $pbparallel = pb_set_parallel($vtype);
    2443 
    2444 my ($vmexist,$vmpid) = (undef,undef);
    2445 my $pm;
    2446 if (defined $pbparallel) {
    2447     $pm = new Parallel::ForkManager($pbparallel);
    2448 
    2449     # Set which port the VM/RM will use to communicate
    2450     $pm->run_on_start(\&pb_set_port);
    2451 }
    2452 
    2453 my $counter = 0;
    2454 foreach my $v (@$v) {
    2455     $counter++;
    2456     # Modulo 2 * pbparallel (to avoid synchronization problems)
    2457     $counter = 1 if ((defined $pbparallel) && ($counter > 2 * $pbparallel));
    2458     $pm->start($counter) and next if (defined $pbparallel);
    2459     # Prepare the script to be executed on the VM/VE/RM
    2460     # in $ENV{'PBDESTDIR'}/pbscript.$$
    2461     open(SCRIPT,"> $ENV{'PBDESTDIR'}/pbscript.$$") || die "Unable to create $ENV{'PBDESTDIR'}/pbscript.$$";
    2462     print SCRIPT "#!/bin/bash\n";
    2463 
    2464     # Transmit the verbosity level to the virtual env/mach.
    2465     my $verbose = "";
    2466     my $i = 0;                          # minimal debug level
    2467     while ($i lt $pbdebug) {
    2468         $verbose .= "-v ";
    2469         $i++;
    2470     }
    2471     # Activate script verbosity if at least 2 for pbdebug
    2472     print SCRIPT "set -x\n" if ($i gt 1);
    2473     # Quiet if asked to be so on the original system
    2474     $verbose = "-q" if ($pbdebug eq -1);
    2475 
    2476     print SCRIPT "echo ... Execution needed\n";
    2477     print SCRIPT "# This is in directory delivery\n";
    2478     print SCRIPT "# Setup the variables required for building\n";
    2479     print SCRIPT "export PBPROJ=$ENV{'PBPROJ'}\n";
    2480 
    2481     if ($action eq "build") {
    2482         print SCRIPT "# Preparation for pb\n";
    2483         print SCRIPT "mv .pbrc \$HOME\n";
    2484         print SCRIPT "cd ..\n";
    2485     }
    2486 
    2487     # VE needs a good /proc
    2488     if ($vtype eq "ve") {
    2489         print SCRIPT "sudo /bin/mount -t proc /proc /proc\n";
    2490     }
    2491 
    2492     # Get distro context
    2493     my $pbos = pb_distro_get_context($v);
    2494    
    2495     my $ntpline = pb_date2v($vtype,$pbos);
    2496     print SCRIPT "# Time sync\n";
    2497     print SCRIPT "echo 'setting up date with '";
    2498     print SCRIPT "echo $ntpline\n";
    2499     print SCRIPT "$ntpline\n";
    2500     # Use potential local proxy declaration in case we need it to download repo, pkgs, ...
    2501     if (defined $ENV{'http_proxy'}) {
    2502         print SCRIPT "export http_proxy=\"$ENV{'http_proxy'}\"\n";
    2503     }
    2504 
    2505     if (defined $ENV{'ftp_proxy'}) {
    2506         print SCRIPT "export ftp_proxy=\"$ENV{'ftp_proxy'}\"\n";
    2507     }
    2508 
    2509     # Get list of packages to build/test and get some ENV vars as well
    2510     my $ptr = pb_get_pkg();
    2511     @pkgs = @$ptr;
    2512     my $p = join(' ',@pkgs) if (@pkgs);
    2513     print SCRIPT "export PBPROJVER=$ENV{'PBPROJVER'}\n";
    2514     print SCRIPT "export PBPROJTAG=$ENV{'PBPROJTAG'}\n";
    2515     print SCRIPT "export PBPACKAGER=\"$ENV{'PBPACKAGER'}\"\n";
    2516 
    2517     # We may need to do some other tasks before building. Read a script here to finish setup
    2518     if (-x "$ENV{'PBDESTDIR'}/pb$vtype".".pre") {
    2519         print SCRIPT "# Special pre-instructions to be launched\n";
    2520         print SCRIPT pb_get_content("$ENV{'PBDESTDIR'}/pb$vtype".".pre");
    2521     }
    2522 
    2523     if (-x "$ENV{'PBDESTDIR'}/pb$vtype"."$action.pre") {
    2524         print SCRIPT "# Special pre-$action instructions to be launched\n";
    2525         print SCRIPT pb_get_content("$ENV{'PBDESTDIR'}/pb$vtype"."$action.pre");
    2526     }
    2527 
    2528     print SCRIPT "# $action\n";
    2529     print SCRIPT "echo $action"."ing packages on $vtype...\n";
    2530 
    2531     if (($action eq "test") && (! -x "$ENV{'PBDESTDIR'}/pbtest")) {
    2532             die "No test script ($ENV{'PBDESTDIR'}/pbtest) found when in test mode. Aborting ...";
    2533     }
    2534     print SCRIPT "pb $verbose -p $ENV{'PBPROJ'} $action"."2pkg $p\n";
    2535 
    2536     if ($vtype eq "ve") {
    2537         print SCRIPT "sudo /bin/umount /proc\n";
    2538     }
    2539 
    2540     # We may need to do some other tasks after building. Read a script here to exit properly
    2541     if (-x "$ENV{'PBDESTDIR'}/pb$vtype"."$action.post") {
    2542         print SCRIPT "# Special post-$action instructions to be launched\n";
    2543         print SCRIPT pb_get_content("$ENV{'PBDESTDIR'}/pb$vtype"."$action.post");
    2544     }
    2545 
    2546     if (-x "$ENV{'PBDESTDIR'}/pb$vtype".".post") {
    2547         print SCRIPT "# Special post-instructions to be launched\n";
    2548         print SCRIPT pb_get_content("$ENV{'PBDESTDIR'}/pb$vtype".".post");
    2549     }
    2550 
    2551     close(SCRIPT);
    2552     chmod 0755,"$ENV{'PBDESTDIR'}/pbscript.$$";
    2553    
    2554     # Launch the VM/VE/RM
    2555     ($vmexist,$vmpid) = pb_launchv($vtype,$v,0);
    2556 
    2557 
    2558     if ($vtype eq "vm") {
    2559         # Skip that VM if something went wrong
    2560         if (($vmpid == 0) && ($vmexist == 0)) {
    2561             $pm->finish if (defined $pbparallel);
    2562             next;
    2563         }
    2564     } else {
    2565         # VE/RM
    2566         $vmexist = 0;
    2567         $vmpid = 0;
    2568     }
    2569     # Gather all required files to send them to the VM/VE
    2570     # and launch the build through pbscript
    2571     pb_log(2,"Calling send2target $vtype,$v,$vmexist,$vmpid\n");
    2572     pb_send2target(uc($vtype).$action,"$v",$vmexist,$vmpid);
    2573     $pm->finish if (defined $pbparallel);
    2574 }
    2575 $pm->wait_all_children if (defined $pbparallel);
    2576 }
    2577 
    2578 
    2579 sub pb_clean {
    2580 
    2581     my $sleep=10;
    2582     die "Unable to get env var PBDESTDIR" if (not defined $ENV{'PBDESTDIR'});
    2583     die "Unable to get env var PBBUILDDIR" if (not defined $ENV{'PBBUILDDIR'});
    2584     pb_log(0,"We will now wait $sleep s before removing both directories\n$ENV{'PBDESTDIR'} and $ENV{'PBBUILDDIR'}.\nPlease break me if this is wrong\n");
    2585     sleep $sleep;
    2586     pb_rm_rf($ENV{'PBDESTDIR'});
    2587     pb_rm_rf($ENV{'PBBUILDDIR'});
    2588 }
    2589 
    2590 sub pb_newver {
    2591 
    2592     die "-V Version parameter needed" if ((not defined $newver) || ($newver eq ""));
    2593 
    2594     # Need this call for PBDIR
    2595     my ($scheme2,$uri) = pb_cms_init($pbinit);
    2596 
    2597     my ($pbconf,$pburl) = pb_conf_get("pbconfurl","pburl");
    2598     $uri = $pbconf->{$ENV{'PBPROJ'}};
    2599     my ($scheme, $account, $host, $port, $path) = pb_get_uri($uri);
    2600 
    2601     # Checking CMS repositories status
    2602     ($scheme2, $account, $host, $port, $path) = pb_get_uri($pburl->{$ENV{'PBPROJ'}});
    2603 
    2604     if ($scheme !~ /^svn/) {
    2605         die "Only SVN is supported at the moment";
    2606     }
    2607 
    2608     my $res = pb_cms_isdiff($scheme,$ENV{'PBROOTDIR'});
    2609     die "ERROR: No differences accepted in CMS for $ENV{'PBROOTDIR'} before creating a new version" if ($res != 0);
    2610 
    2611     $res = pb_cms_isdiff($scheme2,$ENV{'PBDIR'});
    2612     die "ERROR: No differences accepted in CMS for $ENV{'PBDIR'} before creating a new version" if ($res != 0);
    2613 
    2614     # Tree identical between PBCONFDIR and PBROOTDIR. The delta is what
    2615     # we want to get for the root of the new URL
    2616 
    2617     my $oldver = $ENV{'PBROOTDIR'};
    2618     $oldver =~ s|^$ENV{'PBCONFDIR'}||;
    2619 
    2620     pb_log(2, "PBCONFDIR: $ENV{'PBCONFDIR'}\nPBROOTDIR: $ENV{'PBROOTDIR'}\n");
    2621 
    2622     my $newurl = "$uri/$newver";
    2623     # Should probably use projver in the old file
    2624     my $oldvertxt= basename($oldver);
    2625     my $newvertxt = basename($newver);
    2626 
    2627     # Duplicate and extract project-builder part
    2628     pb_log(2,"Copying $uri/$oldver to $newurl\n");
    2629     pb_cms_copy($scheme,"$uri/$oldver",$newurl);
    2630     pb_log(2,"Checkout $newurl to $ENV{'PBCONFDIR'}/$newver\n");
    2631     pb_cms_up($scheme,"$ENV{'PBCONFDIR'}");
    2632 
    2633     # Duplicate and extract project
    2634     my $newurl2 = "$pburl->{$ENV{'PBPROJ'}}/$newver";
    2635 
    2636     pb_log(2,"Copying $pburl->{$ENV{'PBPROJ'}}/$oldver to $newurl2\n");
    2637     pb_cms_copy($scheme2,"$pburl->{$ENV{'PBPROJ'}}/$oldver",$newurl2);
    2638 
    2639     my $tmp = $ENV{'PBDIR'};
    2640     $tmp =~ s|$oldver$||;
    2641     pb_log(2,"Checkout $newurl2 to $tmp/$newver\n");
    2642     pb_cms_up($scheme2,"$tmp");
    2643 
    2644     # Update the .pb file
    2645     open(FILE,"$ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb") || die "Unable to open $ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb";
    2646     open(OUT,"> $ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb.new") || die "Unable to write to $ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb.new";
    2647     while(<FILE>) {
    2648         if (/^projver\s+$ENV{'PBPROJ'}\s*=\s*$oldvertxt$/) {
    2649             s/^projver\s+$ENV{'PBPROJ'}\s*=\s*$oldvertxt$/projver $ENV{'PBPROJ'} = $newvertxt/;
    2650             pb_log(0,"Changing projver from $oldvertxt to $newvertxt in $ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb\n");
    2651         }
    2652         if (/^testver/) {
    2653             s/^testver/#testver/;
    2654             pb_log(0,"Commenting testver in $ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb\n") if (/^testver/);
    2655         }
    2656         if (/^delivery/) {
    2657             my $txt = $_;
    2658             chomp($txt);
    2659             pb_log(0,"Please check delivery ($txt) in $ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb\n");
    2660         }
    2661         print OUT $_;
    2662     }
    2663     close(FILE);
    2664     close(OUT);
    2665     rename("$ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb.new","$ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb");
    2666 
    2667     # Checking pbcl files
    2668     foreach my $f (<$ENV{'PBROOTDIR'}/*/pbcl>) {
    2669         # Compute new pbcl file
    2670         my $f2 = $f;
    2671         $f2 =~ s|$ENV{'PBROOTDIR'}|$ENV{'PBCONFDIR'}/$newver/|;
    2672         open(PBCL,$f) || die "Unable to open $f";
    2673         my $foundnew = 0;
    2674         while (<PBCL>) {
    2675             $foundnew = 1 if (/^$newvertxt \(/);
    2676         }
    2677         close(PBCL);
    2678         open(OUT,"> $f2") || die "Unable to write to $f2: $!";
    2679         open(PBCL,$f) || die "Unable to open $f";
    2680         while (<PBCL>) {
    2681             print OUT "$_" if (not /^$oldvertxt \(/);
    2682             if ((/^$oldvertxt \(/) && ($foundnew == 0)) {
    2683                 print OUT "$newvertxt ($pbdate)\n";
    2684                 print OUT "- TBD\n";
    2685                 print OUT "\n";
    2686                 pb_log(0,"WARNING: version $newvertxt not found in $f so added to $f2...\n") if ($foundnew == 0);
    2687             }
    2688         }
    2689         close(OUT);
    2690         close(PBCL);
    2691     }
    2692 
    2693     pb_log(2,"Checkin $ENV{'PBCONFDIR'}/$newver\n");
    2694     pb_cms_checkin($scheme,"$ENV{'PBCONFDIR'}/$newver",undef);
    2695 }
    2696 
    2697 #
    2698 # Return the list of VMs/VEs/RMs we are working on
    2699 # $all is a flag to know if we return all of them
    2700 # or only some (if all we publish also tar files in addition to pkgs
    2701 #
    2702 sub pb_get2v {
    2703 
    2704 my $vtype = shift;
    2705 my @v;
    2706 my $all = 0;
    2707 my $pbv = 'PBV';
    2708 my $vlist = $vtype."list";
    2709 
    2710 # Get VM/VE list
    2711 if ((not defined $ENV{$pbv}) || ($ENV{$pbv} =~ /^all$/)) {
    2712     my ($ptr) = pb_conf_get($vlist);
    2713     $ENV{$pbv} = $ptr->{$ENV{'PBPROJ'}};
    2714     $all = 1;
    2715 }
    2716 pb_log(2,"$vtype: $ENV{$pbv}\n");
    2717 @v = split(/,/,$ENV{$pbv});
    2718 return(\@v,$all);
    2719 }
    2720 
    2721 # Function to create a potentialy missing pb account on the VM/VE/RM, and adds it to sudo
    2722 # Needs to use root account to connect to the VM/VE/RM
    2723 # pb will take your local public SSH key to access
    2724 # the pb account in the VM/VE/RM later on if needed
    2725 sub pb_setup2v {
    2726 
    2727 my $vtype = shift;
    2728 my $sbx = shift || undef;
    2729 
    2730 my ($vm,$all) = pb_get2v($vtype);
    2731 
    2732 # Script generated
    2733 my $pbscript = "$ENV{'PBDESTDIR'}/setupv";
    2734 
    2735 # Adapt // mode to memory size
    2736 $pbparallel = pb_set_parallel($vtype);
    2737 
    2738 my $pm;
    2739 if (defined $pbparallel) {
    2740     $pm = new Parallel::ForkManager($pbparallel);
    2741 
    2742     # Set which port the VM/RM will use to communicate
    2743     $pm->run_on_start(\&pb_set_port);
    2744 }
    2745 
    2746 my $counter = 0;
    2747 foreach my $v (@$vm) {
    2748     $counter++;
    2749     # Modulo pbparallel
    2750     $counter = 1 if ((defined $pbparallel) && ($counter > $pbparallel));
    2751     $pm->start($counter) and next if (defined $pbparallel);
    2752 
    2753     # Get distro context
    2754     my $pbos = pb_distro_get_context($v);
    2755    
    2756     # Deal with date sync.
    2757     my $ntpline = pb_date2v($vtype,$pbos);
    2758 
    2759     # Name of the account to deal with for VM/VE/RM
    2760     # Do not use the one passed potentially with -a
    2761     my ($pbac) = pb_conf_get($vtype."login");
    2762     my ($key,$zero0,$zero1,$zero2);
    2763     my ($vmexist,$vmpid);
    2764 
    2765     # Prepare the script to be executed on the VM/VE/RM
    2766     # in $ENV{'PBDESTDIR'}/setupv
    2767     open(SCRIPT,"> $pbscript") || die "Unable to create $pbscript";
    2768    
    2769     print SCRIPT << 'EOF';
    2770 #!/usr/bin/perl -w
    2771 
    2772 use strict;
    2773 use File::Copy;
    2774 
    2775 # We should not need in this script more functions than what is provided
    2776 # by Base, Conf and Distribution to avoid problems at exec time.
    2777 # They are appended at the end.
    2778 
    2779 # Define mandatory global vars
    2780 our $pbdebug;
    2781 our $pbLOG;
    2782 our $pbsynmsg = "pbscript";
    2783 our $pbdisplaytype = "text";
    2784 our $pblocale = "";
    2785 pb_log_init($pbdebug, $pbLOG);
    2786 EOF
    2787     print SCRIPT << "EOF";
    2788 pb_temp_init($pbkeep);
    2789 
    2790 EOF
    2791 
    2792     # Launch the VM/VE/RM - Usage of snapshot disabled
    2793     ($vmexist,$vmpid) = pb_launchv($vtype,$v,0,0,0);
    2794 
    2795     my $keyfile;
    2796     my $nport;
    2797     my $vmhost;
    2798 
    2799     # Prepare the key to be used and transfered remotely
    2800     $keyfile = pb_ssh_get(1);
    2801        
    2802     if ($vtype =~ /(v|r)m/) {
    2803         my ($vmport);
    2804         ($vmhost,$vmport) = pb_conf_get($vtype."host",$vtype."port");
    2805         $nport = pb_get_port($vmport,$pbos,$vtype);
    2806    
    2807         # Skip that VM/RM if something went wrong
    2808         next if (($vmpid == 0) && ($vmexist == 0));
    2809    
    2810         # Store the pub key part in a variable
    2811         open(FILE,"$keyfile.pub") || die "Unable to open $keyfile.pub";
    2812         ($zero0,$zero1,$zero2) = split(/ /,<FILE>);
    2813         close(FILE);
    2814 
    2815         $key = "\Q$zero1";
    2816 
    2817         # We call true to avoid problems if SELinux is not activated, but chcon is present and returns in that case 1
    2818         pb_system("cat $keyfile.pub | ssh -q -o UserKnownHostsFile=/dev/null -p $nport -i $keyfile root\@$vmhost->{$ENV{'PBPROJ'}} \"mkdir -p .ssh ; chmod 700 .ssh ; cat >> .ssh/authorized_keys ; chmod 600 .ssh/authorized_keys ; if [ -x /usr/bin/chcon ]; then /usr/bin/chcon -Rt home_ssh_t .ssh 2> /dev/null; /bin/true; fi\"","Copying local keys to $vtype. This may require the root password");
    2819         # once this is done, we can do what we need on the VM/RM remotely
    2820     } elsif ($vtype eq "ve") {
    2821         print SCRIPT << "EOF";
    2822 # For VE we need a good null dev
    2823 pb_system("rm -f /dev/null; mknod /dev/null c 1 3; chmod 777 /dev/null");
    2824 EOF
    2825         print SCRIPT << "EOF";
    2826 # For VE we first need to mount some FS
    2827 pb_system("mount -t proc /proc /proc");
    2828 
    2829 EOF
    2830     }
    2831 
    2832     if ($vtype =~ /(v|r)m/) {
    2833         print SCRIPT << 'EOF';
    2834 # Removes duplicate in .ssh/authorized_keys of our key if needed
    2835 #
    2836 my $file1="$ENV{'HOME'}/.ssh/authorized_keys";
    2837 open(PBFILE,$file1) || die "Unable to open $file1";
    2838 open(PBOUT,"> $file1.new") || die "Unable to open $file1.new";
    2839 my $count = 0;
    2840 while (<PBFILE>) {
    2841 
    2842 EOF
    2843         print SCRIPT << "EOF";
    2844     if (/ $key /) {
    2845         \$count++;
    2846     }
    2847 print PBOUT \$_ if ((\$count <= 1) || (\$_ !~ / $key /));
    2848 }
    2849 close(PBFILE);
    2850 close(PBOUT);
    2851 rename("\$file1.new",\$file1);
    2852 chmod 0600,\$file1;
    2853 
    2854 EOF
    2855     }
    2856     print SCRIPT << 'EOF';
    2857 
    2858 # Adds $pbac->{$ENV{'PBPROJ'}} as an account if needed
    2859 #
    2860 my $file="/etc/passwd";
    2861 open(PBFILE,$file) || die "Unable to open $file";
    2862 my $found = 0;
    2863 while (<PBFILE>) {
    2864 EOF
    2865     print SCRIPT << "EOF";
    2866     \$found = 1 if (/^$pbac->{$ENV{'PBPROJ'}}:/);
    2867 EOF
    2868 
    2869 # TODO: use an external parameter
    2870 my $home = "/home";
    2871 # Solaris doesn't like that we use /home
    2872 $home = "/export/home" if ($pbos->{'type'} eq "pkg");
    2873 
    2874     print SCRIPT << "EOF";
    2875 }
    2876 close(PBFILE);
    2877 
    2878 if ( \$found == 0 ) {
    2879     if ( ! -d "$home" ) {
    2880         pb_mkdir_p("$home");
    2881     }
    2882 EOF
    2883     # TODO: Level of portability of these cmds ? Critical now for RM
    2884     # TODO: Check existence before adding to avoid errors
    2885     print SCRIPT << "EOF";
    2886 pb_system("/usr/sbin/groupadd $pbac->{$ENV{'PBPROJ'}}","Adding group $pbac->{$ENV{'PBPROJ'}}");
    2887 pb_system("/usr/sbin/useradd -g $pbac->{$ENV{'PBPROJ'}} -m -d $home/$pbac->{$ENV{'PBPROJ'}} $pbac->{$ENV{'PBPROJ'}}","Adding user $pbac->{$ENV{'PBPROJ'}} (group $pbac->{$ENV{'PBPROJ'}} - home $home/$pbac->{$ENV{'PBPROJ'}})");
    2888 }
    2889 EOF
    2890 
    2891     # Copy the content of our local conf file to the VM/VE/RM
    2892     my $content = pb_get_content(pb_distro_conffile());
    2893     print SCRIPT << "EOF";
    2894     #
    2895     # Create a temporary local conf file for distribution support
    2896     # This is created here before its use later. Its place is hardcoded, so no choice for the path
    2897     #
    2898     my \$tempconf = pb_distro_conffile();
    2899     pb_mkdir_p(dirname(\$tempconf));
    2900     open(CONF,"> \$tempconf") || die "Unable to create \$tempconf";
    2901     print CONF q{$content};
    2902     close(CONF);
    2903 EOF
    2904 
    2905     if ($vtype =~ /(v|r)m/) {
    2906         print SCRIPT << "EOF";
    2907 # allow ssh entry to build
    2908 #
    2909 mkdir "$home/$pbac->{$ENV{'PBPROJ'}}/.ssh",0700;
    2910 # Allow those accessing root to access the build account
    2911 copy("\$ENV{'HOME'}/.ssh/authorized_keys","$home/$pbac->{$ENV{'PBPROJ'}}/.ssh/authorized_keys");
    2912 chmod 0600,".ssh/authorized_keys";
    2913 pb_system("chown -R $pbac->{$ENV{'PBPROJ'}}:$pbac->{$ENV{'PBPROJ'}} $home/$pbac->{$ENV{'PBPROJ'}}","Finish setting up the account env for $pbac->{$ENV{'PBPROJ'}}");
    2914 
    2915 EOF
    2916 }
    2917     print SCRIPT << 'EOF';
    2918 # No passwd for build account only keys
    2919 $file="/etc/shadow";
    2920 if (-f $file) {
    2921     open(PBFILE,$file) || die "Unable to open $file";
    2922     open(PBOUT,"> $file.new") || die "Unable to open $file.new";
    2923     while (<PBFILE>) {
    2924 EOF
    2925     print SCRIPT << "EOF";
    2926         s/^$pbac->{$ENV{'PBPROJ'}}:\!\!:/$pbac->{$ENV{'PBPROJ'}}:*:/;
    2927         s/^$pbac->{$ENV{'PBPROJ'}}:\!:/$pbac->{$ENV{'PBPROJ'}}:*:/; #SLES 9 e.g.
    2928         s/^$pbac->{$ENV{'PBPROJ'}}:\\*LK\\*:/$pbac->{$ENV{'PBPROJ'}}:NP:/;  #Solaris e.g.
    2929 EOF
    2930         print SCRIPT << 'EOF';
    2931         print PBOUT $_;
    2932     }
    2933     close(PBFILE);
    2934     close(PBOUT);
    2935     rename("$file.new",$file);
    2936     chmod 0640,$file;
    2937     }
    2938 
    2939 # Keep the VM in text mode
    2940 $file="/etc/inittab";
    2941 if (-f $file) {
    2942     open(PBFILE,$file) || die "Unable to open $file";
    2943     open(PBOUT,"> $file.new") || die "Unable to open $file.new";
    2944     while (<PBFILE>) {
    2945         s/^(..):5:initdefault:$/$1:3:initdefault:/;
    2946         print PBOUT $_;
    2947     }
    2948     close(PBFILE);
    2949     close(PBOUT);
    2950     rename("$file.new",$file);
    2951     chmod 0640,$file;
    2952 }
    2953 
    2954 # pb has to be added to portage group on gentoo
    2955 
    2956 # We need to have that pb_distro_get_context function
    2957 # Get it from Project-Builder::Distribution
    2958 # And we now need the conf file required for this to work created above
    2959 
    2960 my $pbos = pb_distro_get_context();
    2961 print "distro tuple: ".Dumper($pbos)."\n";
    2962 
    2963 # Adapt sudoers
    2964 # sudo is not default on Solaris and needs to be installed first
    2965 # from http://www.sunfreeware.com/programlistsparc10.html#sudo
    2966 if ($pbos->{'type'} eq "pkg") {
    2967     $file="/usr/local/etc/sudoers";
    2968 } else {
    2969     $file="/etc/sudoers";
    2970 }
    2971 open(PBFILE,$file) || die "Unable to open $file";
    2972 open(PBOUT,"> $file.new") || die "Unable to open $file.new";
    2973 while (<PBFILE>) {
    2974 EOF
    2975     # Skip what will be generated
    2976     print SCRIPT << "EOF";
    2977     next if (/^$pbac->{$ENV{'PBPROJ'}}\\s+/);
    2978     next if (/^Defaults:$pbac->{$ENV{'PBPROJ'}}\\s+/);
    2979     next if (/^Defaults:root \!requiretty/);
    2980 EOF
    2981     print SCRIPT << 'EOF';
    2982     s/Defaults[ \t]+requiretty//;
    2983     print PBOUT $_;
    2984 }
    2985 close(PBFILE);
    2986 EOF
    2987     print SCRIPT << "EOF";
    2988 # Some distro force requiretty at compile time, so disable here
    2989 print PBOUT "Defaults:$pbac->{$ENV{'PBPROJ'}} !requiretty\n";
    2990 print PBOUT "Defaults:root !requiretty\n";
    2991 # Keep proxy configuration while using sudo
    2992 print PBOUT "Defaults:$pbac->{$ENV{'PBPROJ'}}    env_keep += \\\"http_proxy ftp_proxy\\\"\n";
    2993 EOF
    2994     # Try to restrict security to what is really needed
    2995     if ($vtype =~ /^vm/) {
    2996         my $hpath = pb_distro_get_param($pbos,pb_conf_get("ospathcmd-halt"));
    2997         my @sudocmds = pb_get_sudocmds($pbos,$ntpline,"sudo $hpath");
    2998         print SCRIPT << "EOF";
    2999 # This is needed in order to be able on VM to halt the machine from the $pbac->{$ENV{'PBPROJ'}} account at least
    3000 # Build account $pbac->{$ENV{'PBPROJ'}} in VM also needs to setup date and install deps.
    3001 # Nothing else should be needed
    3002 EOF
    3003         foreach my $c (@sudocmds) {
    3004             print SCRIPT "print PBOUT \"$pbac->{$ENV{'PBPROJ'}}   ALL = NOPASSWD: $c\\n\";\n";
    3005         }
    3006     } elsif ($vtype =~ /^rm/) {
    3007         my @sudocmds = pb_get_sudocmds($pbos,$ntpline);
    3008         print SCRIPT << "EOF";
    3009 # Build account $pbac->{$ENV{'PBPROJ'}} in RM only needs to setup date and install deps if needed each time
    3010 EOF
    3011         foreach my $c (@sudocmds) {
    3012             print SCRIPT "print PBOUT \"$pbac->{$ENV{'PBPROJ'}}   ALL = NOPASSWD: $c\\n\";\n";
    3013         }
    3014     } else {
    3015         print SCRIPT << "EOF";
    3016 # Build account $pbac->{$ENV{'PBPROJ'}} for VE needs to do a lot in the host (and chroot), so allow without restriction for now
    3017 print PBOUT "$pbac->{$ENV{'PBPROJ'}}   ALL=(ALL) NOPASSWD:ALL\n";
    3018 EOF
    3019 }
    3020     print SCRIPT << 'EOF';
    3021 close(PBOUT);
    3022 rename("$file.new",$file);
    3023 chmod 0440,$file;
    3024 
    3025 EOF
    3026 
    3027     if ($vtype =~ /(v|r)m/) {
    3028         # Sync date
    3029         # do it after sudoers is setup
    3030         print SCRIPT "pb_system(\"$ntpline\");\n";
    3031     }
    3032     # We may need a proxy configuration. Get it from the local env
    3033 
    3034     if (defined $ENV{'http_proxy'}) {
    3035         print SCRIPT "\$ENV\{'http_proxy'\}=\"$ENV{'http_proxy'}\";\n";
    3036     }
    3037 
    3038     if (defined $ENV{'ftp_proxy'}) {
    3039         print SCRIPT "\$ENV\{'ftp_proxy'\}=\"$ENV{'ftp_proxy'}\";\n";
    3040     }
    3041 
    3042     print SCRIPT << 'EOF';
    3043    
    3044 # Suse wants sudoers as 640
    3045 if ((($pbos->{'name'} eq "sles") && (($pbos->{'version'} =~ /10/) || ($pbos->{'version'} =~ /9/))) || (($pbos->{'name'} eq "opensuse") && ($pbos->{'version'} =~ /10.[012]/))) {
    3046     chmod 0640,$file;
    3047 }
    3048 
    3049 # First install all required packages
    3050 pb_system("yum clean all","Cleaning yum env") if (($pbos->{'name'} eq "fedora") || ($pbos->{'name'} eq "asianux") || ($pbos->{'name'} eq "rhel"));
    3051 my ($ospkgdep) = pb_conf_get_if("ospkgdep");
    3052    
    3053 my $pkgdep = pb_distro_get_param($pbos,$ospkgdep);
    3054 pb_distro_installdeps(undef,$pbos,pb_distro_only_deps_needed($pbos,join(' ',split(/,/,$pkgdep))));
    3055 
    3056 EOF
    3057     my $itype = pb_distro_get_param($pbos,pb_conf_get("pbinstalltype"));
    3058     # Install from sandbox mean a file base install
    3059     $itype = "file" if (defined $sbx);
    3060     if ($itype =~ /^file/) {
    3061         my $cmdget;
    3062         if (defined $sbx) {
    3063             # Install from sandbox mean using the result of the just passed sbx2build command
    3064             # Get content saved in cms2build
    3065             my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
    3066             my $pbextdir = pb_get_extdir();
    3067             die "Unable to get package list" if (not defined $pkg);
    3068 
    3069             # We consider 2 specific packages
    3070             my $vertag1 = $pkg->{"ProjectBuilder"};
    3071             my $vertag2 = $pkg->{"project-builder"};
    3072             # get the version of the current package - maybe different
    3073             pb_log(2,"Vertag1: $vertag1\n");
    3074             pb_log(2,"Vertag2: $vertag2\n");
    3075             my ($pbver1,$tmp1) = split(/-/,$vertag1);
    3076             my ($pbver2,$tmp2) = split(/-/,$vertag2);
    3077             # Copy inside the VE
    3078             if ($vtype eq "ve") {
    3079                 my ($vepath) = pb_conf_get("vepath");
    3080                 copy("$ENV{'PBDESTDIR'}/ProjectBuilder-$pbver1$pbextdir.tar.gz","$vepath->{$ENV{'PBPROJ'}}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}/tmp");
    3081                 copy("$ENV{'PBDESTDIR'}/project-builder-$pbver2$pbextdir.tar.gz","$vepath->{$ENV{'PBPROJ'}}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}/tmp");
    3082             } else {
    3083                 pb_system("scp -i $keyfile -p -o UserKnownHostsFile=/dev/null -P $nport $ENV{'PBDESTDIR'}/ProjectBuilder-$pbver1$pbextdir.tar.gz $ENV{'PBDESTDIR'}/project-builder-$pbver2$pbextdir.tar.gz root\@$vmhost->{$ENV{'PBPROJ'}}:/tmp","Copying local project files to $vtype.");
    3084             }
    3085             $cmdget = "mv /tmp/ProjectBuilder-$pbver1$pbextdir.tar.gz ProjectBuilder-latest.tar.gz ; mv /tmp/project-builder-$pbver2$pbextdir.tar.gz project-builder-latest.tar.gz";
    3086         } else {
    3087             $cmdget = "wget --passive-ftp ftp://ftp.project-builder.org/src/ProjectBuilder-latest.tar.gz; wget --passive-ftp ftp://ftp.project-builder.org/src/project-builder-latest.tar.gz";
    3088         }
    3089         print SCRIPT << 'EOF';
    3090 # Then install manually the missing perl modules
    3091 my ($osperldep,$osperlver) = pb_conf_get_if("osperldep","osperlver");
    3092    
    3093 my $perldep = pb_distro_get_param($pbos,$osperldep);
    3094 foreach my $m (split(/,/,$perldep)) {
    3095     # Skip empty deps
    3096     next if ($m =~ /^\s*$/);
    3097     my $dir = $m;
    3098     $dir =~ s/-.*//;
    3099     pb_system("echo \"rm -rf $m* ; wget http://search.cpan.org/CPAN/modules/by-module/$dir/$m-$osperlver->{$m}.tar.gz ; gzip -cd $m-$osperlver->{$m}.tar.gz | tar xf - ; cd $m* ; if [ -f Build.PL ]; then perl Build.PL; ./Build ; ./Build install ; else perl Makefile.PL; make ; make install ; fi; cd .. ; rm -rf $m*\" | bash" ,"Installing perl module $m-$osperlver->{$m}");
    3100 }
    3101 EOF
    3102         print SCRIPT << 'EOF';
    3103 pb_system("rm -rf ProjectBuilder-* ; rm -rf project-builder-* ; rm -rf `perl -V:installvendorlib  | awk -F\"'\" '{print \$2}'`/ProjectBuilder ;
    3104 EOF
    3105         print SCRIPT " $cmdget ; ";
    3106         print SCRIPT << 'EOF'
    3107 gzip -cd ProjectBuilder-latest.tar.gz | tar xf - ; cd ProjectBuilder-* ; perl Makefile.PL ; make ; make install ; cd .. ; rm -rf ProjectBuilder-* ; gzip -cd project-builder-latest.tar.gz | tar xf - ; cd project-builder-* ; perl Makefile.PL ; make ; make install ; cd .. ; rm -rf project-builder-* ;","Building Project-Builder");
    3108 EOF
    3109     } elsif ($itype =~ /^pkg/) {
    3110         # pkg based install. We need to point to the project-builder.org repository
    3111         print SCRIPT << 'EOF';
    3112 my $pkgforpb = pb_distro_get_param($pbos,pb_conf_get_if("ospkg"));
    3113 pb_distro_setuposrepo($pbos);
    3114 pb_distro_installdeps(undef,$pbos,pb_distro_only_deps_needed($pbos,join(' ',split(/,/,$pkgforpb))));
    3115 EOF
    3116     } else {
    3117         # Unknown install type
    3118         die("Unknown install type $itype->{$ENV{'PBPROJ'}} for param pbinstalltype");
    3119     }
    3120     print SCRIPT << 'EOF';
    3121 pb_system("pb 2>&1 | head -5",undef,"verbose");
    3122 pb_system("pbdistrocheck",undef,"verbose");
    3123 EOF
    3124     if ($vtype eq "ve") {
    3125             print SCRIPT << 'EOF';
    3126 # For VE we need to umount some FS at the end
    3127 
    3128 pb_system("umount /proc");
    3129 
    3130 # Create a basic network file if not already there
    3131 
    3132 my $nf="/etc/sysconfig/network";
    3133 if ((! -f $nf) && ($pbos->{'type'} eq "rpm")) {
    3134     open(NF,"> $nf") || die "Unable to create $nf";
    3135     print NF "NETWORKING=yes\n";
    3136     print NF "HOSTNAME=localhost\n";
    3137     close(NF);
    3138 }
    3139 chmod 0755,$nf;
    3140 EOF
    3141     }
    3142 
    3143     # Adds pb_distro_get_context and all functions needed from ProjectBuilder::Distribution, Conf and Base
    3144     foreach my $d (@INC) {
    3145         my @f = ("$d/ProjectBuilder/Base.pm","$d/ProjectBuilder/Distribution.pm","$d/ProjectBuilder/Conf.pm");
    3146         foreach my $f (@f) {
    3147             if (-f "$f") {
    3148                 open(PBD,"$f") || die "Unable to open $f";
    3149                 while (<PBD>) {
    3150                     next if (/^package/);
    3151                     next if (/^use Exporter/);
    3152                     next if (/^use ProjectBuilder::/);
    3153                     next if (/^our /);
    3154                     print SCRIPT $_;
    3155                 }
    3156                 close(PBD);
    3157             }
    3158         }
    3159     }
    3160     # Use a fake pb_version_init version here
    3161     print SCRIPT << "EOF";
    3162 sub pb_version_init {
    3163 
    3164 return("$projectbuilderver","$projectbuilderrev");
    3165 }
    3166 1;
    3167 EOF
    3168     close(SCRIPT);
    3169     chmod 0755,"$pbscript";
    3170 
    3171     # That build script needs to be run as root and force stop of VM at end
    3172     $pbaccount = "root";
    3173 
    3174     # Force shutdown of VM except if it was already launched
    3175     my $pbforce = 0;
    3176     if ((! $vmexist) && ($vtype eq "vm")) {
    3177         $pbforce = 1;
    3178     }
    3179    
    3180     pb_script2v($pbscript,$vtype,$pbforce,$v);
    3181     $pm->finish if (defined $pbparallel);
    3182 }
    3183 $pm->wait_all_children if (defined $pbparallel);
    3184 return;
    3185 }
    3186 
    3187 # Function to create a snapshot named 'pb' for VMs and a compressed tar for VEs
    3188 sub pb_snap2v {
    3189 
    3190 my $vtype = shift;
    3191 
    3192 my ($vm,$all) = pb_get2v($vtype);
    3193 
    3194 # Script generated
    3195 my $pbscript = "$ENV{'PBDESTDIR'}/snapv";
    3196 
    3197 my ($pbac) = pb_conf_get($vtype."login");
    3198 
    3199 foreach my $v (@$vm) {
    3200     if ($vtype eq "ve") {
    3201         # Get distro context
    3202         my $pbos = pb_distro_get_context($v);
    3203         my ($vepath) = pb_conf_get("vepath");
    3204 
    3205         # Test if an existing snapshot exists and remove it if there is a VE
    3206         if ((-f "$vepath->{$ENV{'PBPROJ'}}/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}.tar.gz") &&
    3207             (! -d "$vepath->{$ENV{'PBPROJ'}}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}")) {
    3208                 pb_system("sudo rm -f $vepath->{$ENV{'PBPROJ'}}/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}.tar.gz","Removing previous snapshot $pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}.tar.gz");
    3209         }
    3210     }
    3211 
    3212     # Prepare the script to be executed on the VM/VE
    3213     open(SCRIPT,"> $pbscript") || die "Unable to create $pbscript";
    3214     print SCRIPT << 'EOF';
    3215     #!/bin/bash
    3216     sleep 2
    3217 EOF
    3218     close(SCRIPT);
    3219     chmod 0755,"$pbscript";
    3220 
    3221     # Force shutdown of VM/VE
    3222     # Force snapshot of VM/VE
    3223     pb_script2v($pbscript,$vtype,1,$v,1);
    3224 }
    3225 return;
    3226 }
    3227 
    3228 # Function to update VMs/VEs/RMs with the latest distribution content
    3229 sub pb_update2v {
    3230 
    3231 my $vtype = shift;
    3232 
    3233 my ($vm,$all) = pb_get2v($vtype);
    3234 
    3235 # Script generated
    3236 my $pbscript = "$ENV{'PBDESTDIR'}/updatev";
    3237 
    3238 my ($pbac) = pb_conf_get($vtype."login");
    3239 
    3240 foreach my $v (@$vm) {
    3241     # Get distro context
    3242     my $pbos = pb_distro_get_context($v);
    3243 
    3244     # Prepare the script to be executed on the VM/VE/RM
    3245     # in $ENV{'PBDESTDIR'}/updatev
    3246     open(SCRIPT,"> $pbscript") || die "Unable to create $pbscript";
    3247    
    3248     print SCRIPT << 'EOF';
    3249     #!/bin/bash
    3250     sleep 2
    3251 EOF
    3252     # VE needs a good /proc
    3253     if ($vtype eq "ve") {
    3254         print SCRIPT "sudo /bin/mount -t proc /proc /proc\n";
    3255     }
    3256     print SCRIPT "$pbos->{'update'}\n";
    3257     if ($vtype eq "ve") {
    3258         print SCRIPT "sudo /bin/umount /proc\n";
    3259     }
    3260     close(SCRIPT);
    3261     chmod 0755,"$pbscript";
    3262 
    3263     # Force shutdown of VM except
    3264     pb_script2v($pbscript,$vtype,1,$v);
    3265 }
    3266 return;
    3267 }
    3268 
    3269 sub pb_announce {
    3270 
    3271     my $antype = shift;
    3272 
    3273     # Get all required parameters
    3274     my ($pbpackager,$pbrepo,$pbml,$pbsmtp) = pb_conf_get("pbpackager","pbrepo","pbml","pbsmtp");
    3275     my ($pkgv, $pkgt, $testver) = pb_conf_get_if("pkgver","pkgtag","testver");
    3276     if (((not defined $testver) || (not defined $testver->{$ENV{'PBPROJ'}}) || ($testver->{$ENV{'PBPROJ'}} !~ /true/i)) && ($antype eq "Clean")) {
    3277         # We just clean for test versions
    3278         pb_log(0,"Unable to clean SSH repository for non testver version\n");
    3279         return;
    3280     }
    3281     my $pkg = pb_cms_get_pkg($defpkgdir,$extpkgdir);
    3282     my @pkgs = @$pkg;
    3283     my %pkgs;
    3284     my $first = 0;
    3285 
    3286     # Get all distros concerned
    3287     my $pbos = pb_distro_get_context();
    3288     my $distrolist = pb_get_distros($pbos,undef);
    3289     my %dl;
    3290     my %theorlist;
    3291     my %archlist;
    3292     foreach my $d (split(/,/,$distrolist)) {
    3293         my ($d1,$d2,$d3) = split(/-/,$d);
    3294         $dl{$d1}++;
    3295     }
    3296 
    3297     # Command to find packages on repo
    3298     my $findstr = "find ".join(" ",keys %dl)." ";
    3299     my $srcstr = "";
    3300     # Generated announce files
    3301     my @files;
    3302 
    3303     foreach my $pbpkg (@pkgs) {
    3304         if ($first != 0) {
    3305             $findstr .= "-o ";
    3306         }
    3307         $first++;
    3308         if ((defined $pkgv) && (defined $pkgv->{$pbpkg})) {
    3309             $pbver = $pkgv->{$pbpkg};
    3310         } else {
    3311             $pbver = $ENV{'PBPROJVER'};
    3312         }
    3313         if ((defined $pkgt) && (defined $pkgt->{$pbpkg})) {
    3314             $pbtag = $pkgt->{$pbpkg};
    3315         } else {
    3316             $pbtag = $ENV{'PBPROJTAG'};
    3317         }
    3318 
    3319         # TODO: use virtual/real names here now
    3320         my $pbrealpkg = $pbpkg;
    3321         my $pbrealpkgrpm = pb_cms_get_real_pkg($pbpkg,"rpm");
    3322         my $pbrealpkgdeb = pb_cms_get_real_pkg($pbpkg,"deb");
    3323         if ($antype eq "Clean") {
    3324             # We only clean test versions anyway
    3325             $pbtag = "0";
    3326             my $nver = $pbver;
    3327             my $ntag = "[2-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]";
    3328             $pbver .= $ntag;
    3329             $findstr .= "-name \'$pbrealpkgrpm-$pbver-$pbtag\.*.rpm\' -o -name \'$pbrealpkgrpm-debug-$pbver-$pbtag\.*.rpm\' -o -name \'$pbrealpkgdeb"."_$pbver-$pbtag"."_*\.deb\' -o -name \'$pbrealpkgdeb"."_$pbver-$pbtag.dsc\' -o -name \'$pbrealpkgdeb"."_$pbver-$pbtag.tar.gz\' -o -name \'$pbrealpkg-$nver"."_p$ntag\.ebuild\' -o -name \'$pbrealpkg-$pbver-$pbtag*\.pkg\' -o -name \'$pbrealpkg-$pbver-$pbtag*\.sd\' ";
    3330             $srcstr .= "src/$pbrealpkg-$pbver.tar.gz src/$pbrealpkg-$pbver.pbconf.tar.gz ";
    3331         } else {
    3332             my @date=pb_get_date();
    3333             # the matching is only done on packages made the same day for test version. Hopefully this is enough
    3334             my $nver = $pbver;
    3335             if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i) && ($antype eq "Check")) {
    3336                 $pbtag = "0";
    3337                 my $ntag .= strftime("%Y%m%d*", @date);
    3338                 $nver = $pbver."_p$ntag";
    3339                 $pbver .= $ntag;
    3340             }
    3341             $findstr .= "-name \'$pbrealpkgrpm-$pbver-$pbtag\.*.rpm\' -o -name \'$pbrealpkgdeb"."_$pbver*\.deb\' -o -name \'$pbrealpkg-$nver*\.ebuild\' -o -name \'$pbrealpkg-$pbver*\.pkg\' -o -name \'$pbrealpkg-$pbver*\.sd\' ";
    3342         }
    3343 
    3344         if ($antype eq "Announce") {
    3345             my $chglog;
    3346 
    3347             pb_cms_init($pbinit);
    3348             # Get project info on log file and generate tmp files used later on
    3349             $chglog = "$ENV{'PBROOTDIR'}/$pbpkg/pbcl";
    3350             $chglog = "$ENV{'PBROOTDIR'}/pbcl" if (! -f $chglog);
    3351             $chglog = undef if (! -f $chglog);
    3352 
    3353             open(OUT,"> $ENV{'PBTMP'}/$pbpkg.ann") || die "Unable to create $ENV{'PBTMP'}/$pbpkg.ann: $!";
    3354             my $pb;
    3355             $pb->{'realpkg'} = $pbrealpkg;
    3356             $pb->{'ver'} = $pbver;
    3357             $pb->{'tag'} = $pbtag;
    3358             $pb->{'date'} = $pbdate;
    3359             $pb->{'extdir'} = pb_get_extdir();
    3360             $pb->{'chglog'} = $chglog;
    3361             $pb->{'packager'} = $pbpackager;
    3362             $pb->{'proj'} = $ENV{'PBPROJ'};
    3363             $pb->{'repo'} = $pbrepo;
    3364             $pb->{'pbos'}->{'type'} = "announce";
    3365             $pb->{'pbos'}->{'suffix'} = "none";
    3366             pb_changelog($pb,\*OUT,"yes");
    3367             close(OUT);
    3368             push(@files,"$ENV{'PBTMP'}/$pbpkg.ann");
    3369         } elsif ($antype eq "Check") {
    3370             # For the check we also build the theoritical complete list we should get
    3371             foreach my $d (split(/,/,$distrolist)) {
    3372                 $pbos = pb_distro_get_context($d);
    3373                 if ($pbos->{'type'} eq "rpm") {
    3374                     $theorlist{"$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}/$pbrealpkgrpm-$pbver-$pbtag$pbos->{'suffix'}"} = 0;
    3375                 } elsif ($pbos->{'type'} eq "deb") {
    3376                     $theorlist{"$pbos->{'name'}/$pbos->{'version'}/$pbrealpkgdeb"."_$pbver-$pbtag"} = 0;
    3377                     # TODO are we always using the last arch ?
    3378                     $archlist{"$pbos->{'name'}/$pbos->{'version'}/$pbrealpkgdeb"."_$pbver-$pbtag"} = "$pbos->{'arch'}";
    3379                 } elsif ($pbos->{'type'} eq "ebuild") {
    3380                     my $prefix = "-r";
    3381                     $prefix = "_p" if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i));
    3382                     $theorlist{"$pbos->{'name'}/$pbos->{'version'}/$pbrealpkg-$pbver$prefix$pbtag.ebuild"} = 0;
    3383                     $archlist{"$pbos->{'name'}/$pbos->{'version'}/$pbrealpkg-$pbver$prefix$pbtag.ebuild"} = "$pbos->{'arch'}";
    3384                 } elsif ($pbos->{'type'} eq "pkg") {
    3385                     $theorlist{"$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}/$pbrealpkg-$pbver-$pbtag.pkg"} = 0;
    3386                 } else {
    3387                     pb_log(1,"No theoritical list possible for type $pbos->{'type'}\n");
    3388                 }
    3389             }
    3390         }
    3391         pb_log(2,"theorlist : ".Dumper(%theorlist)."\n");
    3392     }
    3393     if ($antype eq "Announce") {
    3394         $findstr .= " | grep -Ev \'src.rpm\'";
    3395     } elsif ($antype eq "Clean") {
    3396         $findstr .= " | xargs rm -f -v $srcstr ";
    3397     }
    3398 
    3399     # Prepare the command to run and execute it
    3400     open(PBS,"> $ENV{'PBTMP'}/pbscript") || die "Unable to create $ENV{'PBTMP'}/pbscript";
    3401     print PBS "#!/bin/bash\n";
    3402     print PBS "set -x\n" if ($pbdebug gt 1);
    3403     print PBS "$findstr | sort 2> /dev/null\n";
    3404     close(PBS);
    3405     chmod 0755,"$ENV{'PBTMP'}/pbscript";
    3406     pb_send2target("Announce");
    3407 
    3408     my $sl = "Project $ENV{'PBPROJ'} version $ENV{'PBPROJVER'} is now available";
    3409     if ($antype eq "Announce") {
    3410         # Get subject line
    3411         pb_log(0,"Please enter the title of your announce\n");
    3412         pb_log(0,"(By default: $sl)\n");
    3413         my $sl2 = <STDIN>;
    3414         $sl = $sl2 if ($sl2 !~ /^$/);
    3415 
    3416         # Prepare a template of announce
    3417         open(ANN,"> $ENV{'PBTMP'}/announce.html") || die "Unable to create $ENV{'PBTMP'}/announce.html: $!";
    3418         print ANN << "EOF";
    3419 $sl</p>
    3420 
    3421 <p>The project team is happy to announce the availability of a newest version of $ENV{'PBPROJ'} $ENV{'PBPROJVER'}. Enjoy it as usual!</p>
    3422 <p>
    3423 Now available at <a href="$pbrepo->{$ENV{'PBPROJ'}}">$pbrepo->{$ENV{'PBPROJ'}}</a>
    3424 </p>
    3425 <p>
    3426 EOF
    3427     }
    3428 
    3429     open(LOG,"$ENV{'PBTMP'}/system.$$.log") || die "Unable to read $ENV{'PBTMP'}/system.$$.log: $!";
    3430     if ($antype eq "Announce") {
    3431         my $col = 2;
    3432         my $i = 1;
    3433         print ANN << 'EOF';
    3434 <TABLE WIDTH="100%" CELLPADDING="0" CELLSPACING="0" BORDER="0">
    3435 <TR>
    3436 EOF
    3437         while (<LOG>) {
    3438             print ANN "<TD><A HREF=\"$pbrepo->{$ENV{'PBPROJ'}}/$_\">$_</A></TD>";
    3439             $i++;
    3440             if ($i > $col) {
    3441                 print ANN "</TR>\n<TR>";
    3442                 $i = 1;
    3443             }
    3444         }
    3445     } elsif ($antype eq "Clean") {
    3446         while (<LOG>) {
    3447             # skip errors
    3448             next if ($_ !~ /^removed /);
    3449             pb_log(0,"$_");
    3450         }
    3451     } else {
    3452         # In Check mode we need to compare the 2 lists (real and theoritical)
    3453         while (<LOG>) {
    3454             # Get package name and remove what is in extra for the theoritical list (arch at the end)
    3455             chomp();
    3456             # skip find errors
    3457             next if (/^find:/);
    3458             my $p = $_;
    3459             $p =~ s/\.(i[3456]86|x86_64|noarch|src)\.rpm$//;
    3460             $p =~ s/_(i[3456]86|amd64|all).deb$//;
    3461             $p =~ s/(-0\.[0-9]{8})[0-9]{6}/$1*/ if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i));
    3462             $p =~ s/(-r|_p[0-9]+)\.ebuild/$1*/ if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i));
    3463             $theorlist{$p} = -2 if (not defined $theorlist{$p});
    3464             $theorlist{$p} = $theorlist{$p} + 1;
    3465         }
    3466         pb_log(2,"theorlist : ".Dumper(%theorlist)."\n");
    3467     }
    3468     close(LOG);
    3469 
    3470     # Nothing more for the cleanssh case
    3471     return if ($antype eq "Clean");
    3472 
    3473     if ($antype eq "Check") {
    3474         my ($chkex) = pb_conf_get_if("checkexclude");
    3475         my $vmbuildlist = "";
    3476         my $vebuildlist = "";
    3477         my $rmbuildlist = "";
    3478         my @pt = pb_conf_get_if("vmlist","velist","rmlist");
    3479         foreach my $t (sort keys %theorlist) {
    3480             if (defined $theorlist{$t} and $theorlist{$t} >= 1) {
    3481                 pb_log(1,"Packages found for $t\n");
    3482             } elsif (defined $theorlist{$t} and $theorlist{$t} < 0) {
    3483                 pb_log(0,"Extra Package found for $t\n");
    3484             } else {
    3485                 pb_log(2,"Analyzing $t\n");
    3486                 my ($os,$ver,$arch,$package) = split(/\//,$t);
    3487                 # Some distro have no arch subdir
    3488                 if (not defined $package) {
    3489                     $package = $arch;
    3490                     # TODO: If both arch have failed, we just make the last one
    3491                     $arch = $archlist{$t};
    3492                 }
    3493                 my $pbos = pb_distro_get_context("$os-$ver-$arch");
    3494                 my $pkgn = $package;
    3495                 if ($pbos->{'type'} ne "deb") {
    3496                     # package name is more easily found from the end for non deb
    3497                     # as '-' is the separator, but it can also be used in names
    3498                     $pkgn = reverse($package);
    3499                     # search the second '-' and isolate the now last part which is the full name
    3500                     $pkgn =~ s/([^-]+)-([^-]+)-([\S])+$/$3/;
    3501                 } else {
    3502                     $pkgn =~ s/([^_]+)_([\S])+$/$2/;
    3503                 }
    3504                 my $found = 0;
    3505                 # Handle the exclusion of OSes
    3506                 my $excl = "";
    3507                 $excl .= $chkex->{$pkgn} if (defined $chkex->{$pkgn});
    3508                 $excl .= $chkex->{"all"} if (defined $chkex->{"all"});
    3509                 foreach my $ex (split(/,/,$excl)) {
    3510                     $found = 1 if ("$os-$ver-$arch" =~ /^$ex/);
    3511                 }
    3512                 # Skip as excluded
    3513                 next if ($found == 1);
    3514                 pb_log(0,"Package NOT found for $t\n");
    3515                 # Avoid duplicates in list
    3516                 next if ($vmbuildlist =~ /$os-$ver-$arch/);
    3517                 next if ($vebuildlist =~ /$os-$ver-$arch/);
    3518                 next if ($rmbuildlist =~ /$os-$ver-$arch/);
    3519                 # check with which method we need to build
    3520                 if ((defined $pt[0]->{$ENV{'PBPROJ'}}) and ($pt[0]->{$ENV{'PBPROJ'}} =~ /$os-$ver-$arch/)) {
    3521                     $vmbuildlist = "$os-$ver-$arch" if ($vmbuildlist eq "");
    3522                     $vmbuildlist .= ",$os-$ver-$arch" if ($vmbuildlist !~ /$os-$ver-$arch/);
    3523                     next;
    3524                 }
    3525                 if ((defined $pt[1]->{$ENV{'PBPROJ'}}) and ($pt[1]->{$ENV{'PBPROJ'}} =~ /$os-$ver-$arch/)) {
    3526                     $vebuildlist = "$os-$ver-$arch" if ($vebuildlist eq "");
    3527                     $vebuildlist .= ",$os-$ver-$arch" if ($vebuildlist !~ /$os-$ver-$arch/);
    3528                     next;
    3529                 }
    3530                 if ((defined $pt[2]->{$ENV{'PBPROJ'}}) and ($pt[2]->{$ENV{'PBPROJ'}} =~ /$os-$ver-$arch/)) {
    3531                     $rmbuildlist = "$os-$ver-$arch" if ($rmbuildlist eq "");
    3532                     $rmbuildlist .= ",$os-$ver-$arch" if ($rmbuildlist !~ /$os-$ver-$arch/);
    3533                 }
    3534             }
    3535         }
    3536         # If we want to rebuild automatically, let's do it
    3537         if (defined $opts{'rebuild'}) {
    3538             # SandBox or CMS
    3539             pb_log(0,"Rebuilding from SandBox\n");
    3540             pb_log(0,"for VMs: $vmbuildlist\n") if ($vmbuildlist ne "");
    3541             pb_log(0,"for VEs: $vebuildlist\n") if ($vebuildlist ne "");
    3542             pb_log(0,"for RMs: $rmbuildlist\n") if ($rmbuildlist ne "");
    3543             pb_cms2build("SandBox");
    3544             # Which mode
    3545             $ENV{'PBV'} = $vmbuildlist;
    3546             pb_build2v("vm","build") if ($vmbuildlist ne "");
    3547             $ENV{'PBV'} = $vebuildlist;
    3548             pb_build2v("ve","build") if ($vebuildlist ne "");
    3549             $ENV{'PBV'} = $rmbuildlist;
    3550             pb_build2v("rm","build") if ($rmbuildlist ne "");
    3551         }
    3552         # For the check part this is now finished
    3553         return;
    3554     }
    3555 
    3556     print ANN << "EOF";
    3557 </TR>
    3558 </TABLE>
    3559 </p>
    3560 
    3561 <p>As usual source packages are also available in the same directory.</p>
    3562 
    3563 <p>
    3564 Changes are :
    3565 </p>
    3566 <p>
    3567 EOF
    3568     # Get each package changelog content
    3569     foreach my $f (sort(@files)) {
    3570         open(IN,"$f") || die "Unable to read $f:$!";
    3571         while (<IN>) {
    3572             print ANN $_;
    3573         }
    3574         close(IN);
    3575         print ANN "</p><p>\n";
    3576     }
    3577     print ANN "</p>\n";
    3578     close(ANN);
    3579 
    3580     # Allow for modification
    3581     my $editor = "vi";
    3582     $editor = $ENV{'EDITOR'} if (defined $ENV{'EDITOR'});
    3583     pb_system("$editor $ENV{'PBTMP'}/announce.html","Allowing modification of the announce","noredir");
    3584 
    3585     # Store it in DB for external usage (Web pages generation)
    3586     my $db = "$ENV{'PBCONFDIR'}/announces3.sql";
    3587 
    3588     my $precmd = "";
    3589     if (! -f $db) {
    3590         $precmd = "CREATE TABLE announces (id INTEGER PRIMARY KEY AUTOINCREMENT, date DATE, announce VARCHAR[65535])";
    3591     }
    3592 
    3593     my $dbh = DBI->connect("dbi:SQLite:dbname=$db","","",
    3594                         { RaiseError => 1, AutoCommit => 1 })
    3595                         || die "Unable to connect to $db";
    3596 
    3597     if ($precmd ne "") {
    3598         my $sth = $dbh->prepare(qq{$precmd})
    3599                     || die "Unable to create table into $db";
    3600         $sth->execute();
    3601     }
    3602 
    3603     # To read whole file
    3604     local $/;
    3605     open(ANN,"$ENV{'PBTMP'}/announce.html") || die "Unable to read $ENV{'PBTMP'}/announce.html: $!";
    3606     my $announce = <ANN>;
    3607     close(ANN);
    3608    
    3609     pb_log(2,"INSERT INTO announces VALUES (NULL, $pbdate, $announce)");
    3610     my $sth = $dbh->prepare(qq{INSERT INTO announces VALUES (NULL,?,?)})
    3611                     || die "Unable to insert into $db";
    3612     $sth->execute($pbdate, $announce);
    3613     $sth->finish();
    3614     $dbh->disconnect;
    3615 
    3616     # Then deliver it on the Web
    3617     # $TOOLHOME/livwww www
    3618 
    3619     # Mail it to project's ML
    3620     open(ML,"| w3m -dump -T text/html > $ENV{'PBTMP'}/announce.txt") || die "Unable to create $ENV{'PBTMP'}/announce.txt: $!";
    3621     print ML << 'EOF';
    3622 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/x html1/DTD/xhtml1-strict.dtd">
    3623 
    3624 <html xmlns="http://www.w3.org/1999/xhtml" dir="ltr" xml:lang="en" lang="en">
    3625   <head>
    3626   </head>
    3627   <body>
    3628   <p>
    3629 EOF
    3630     open(ANN,"$ENV{'PBTMP'}/announce.html") || die "Unable to read $ENV{'PBTMP'}/announce.html: $!";
    3631     while(<ANN>) {
    3632         print ML $_;
    3633     }
    3634     print ML << 'EOF';
    3635 </body>
    3636 </html>
    3637 EOF
    3638     close(ML);
    3639 
    3640     # To read whole file
    3641     local $/;
    3642     open(ANN,"$ENV{'PBTMP'}/announce.txt") || die "Unable to read $ENV{'PBTMP'}/announce.txt: $!";
    3643     my $msg = <ANN>;
    3644     close(ANN);
    3645    
    3646     # Preparation of headers
    3647     eval
    3648     {
    3649         require Mail::Sendmail;
    3650         Mail::Sendmail->import();
    3651     };
    3652     if ($@) {
    3653         # Mail::Sendmail not found not sending mail !
    3654         pb_log(0,"No Mail::Sendmail module found so not sending any mail !\n");
    3655     } else {
    3656         my %mail = (   
    3657             To          =>  $pbml->{$ENV{'PBPROJ'}},
    3658             From        =>  $pbpackager->{$ENV{'PBPROJ'}},
    3659             Smtp        =>  $pbsmtp->{$ENV{'PBPROJ'}},
    3660             Body        =>  $msg,
    3661             Subject     =>  "[ANNOUNCE] $sl",
    3662         );
    3663            
    3664         # Send mail
    3665         if (! sendmail(%mail)) {
    3666             if ((defined $Mail::Sendmail::error) and (defined $Mail::Sendmail::log)) {
    3667                 die "Unable to send mail ($Mail::Sendmail::error): $Mail::Sendmail::log";
    3668             }
    3669         }
    3670     }
    3671 }
    3672 
    3673 #
    3674 # Creates a set of HTML file containing the news for the project
    3675 # based on what has been generated by the pb_announce function
    3676 #
    3677 sub pb_web_news2html {
    3678 
    3679     my $dest = shift || $ENV{'PBTMP'};
    3680 
    3681     # Get all required parameters
    3682     my ($pkgv, $pkgt) = pb_conf_get_if("pkgver","pkgtag");
    3683 
    3684     # DB of announces for external usage (Web pages generation)
    3685     my $db = "$ENV{'PBCONFDIR'}/announces3.sql";
    3686 
    3687     my $dbh = DBI->connect("dbi:SQLite:dbname=$db","","",
    3688                         { RaiseError => 1, AutoCommit => 1 })
    3689                         || die "Unable to connect to $db";
    3690     # For date handling
    3691     $ENV{LANGUAGE}="C";
    3692     my $firstjan = strftime("%Y-%m-%d", 0, 0, 0, 1, 0, localtime->year(), 0, 0, -1);
    3693     my $oldfirst = strftime("%Y-%m-%d", 0, 0, 0, 1, 0, localtime->year()-1, 0, 0, -1);
    3694     pb_log(2,"firstjan: $firstjan, oldfirst: $oldfirst, pbdate:$pbdate\n");
    3695     my $all = $dbh->selectall_arrayref("SELECT id,date,announce FROM announces ORDER BY date DESC");
    3696     my %news;
    3697     $news{"cy"} = "";   # current year's news
    3698     $news{"ly"} = "";   # last year news
    3699     $news{"py"} = "";   # previous years news
    3700     $news{"fp"} = "";   # first page news
    3701     my $cpt = 4;        # how many news for first page
    3702     # Extract info from DB
    3703     foreach my $row (@$all) {
    3704         my ($id, $date, $announce) = @$row;
    3705         $news{"cy"} = $news{"cy"}."<p><B>$date</B> $announce\n" if ((($date cmp $pbdate) le 0) && (($firstjan cmp $date) le 0));
    3706         $news{"ly"} = $news{"ly"}."<p><B>$date</B> $announce\n" if ((($date cmp $firstjan) le 0) && (($oldfirst cmp $date) le 0));
    3707         $news{"py"} = $news{"py"}."<p><B>$date</B> $announce\n" if (($date cmp $oldfirst) le 0);
    3708         $news{"fp"} = $news{"fp"}."<p><B>$date</B> $announce\n" if ($cpt > 0);
    3709         $cpt--;
    3710     }
    3711     pb_log(1,"news{fp}: ".$news{"fp"}."\n");
    3712     $dbh->disconnect;
    3713 
    3714     # Generate the HTML content
    3715     foreach my $pref (keys %news) {
    3716         open(NEWS,"> $dest/pb_web_$pref"."news.html") || die "Unable to create $dest/pb_web_$pref"."news.html: $!";
    3717         print NEWS "$news{$pref}";
    3718         close(NEWS);
    3719     }
    3720 }
    3721 
    3722 
    3723 # Return the SSH key file to use
    3724 # Potentially create it if needed
    3725 
    3726 sub pb_ssh_get {
    3727 
    3728 my $create = shift || 0;    # Do not create keys by default
    3729 
    3730 # Check the SSH environment
    3731 my $keyfile = undef;
    3732 
    3733 # We have specific keys by default
    3734 $keyfile = "$ENV{'HOME'}/.ssh/pb_dsa";
    3735 if (!(-e $keyfile) && ($create eq 1)) {
    3736     pb_system("ssh-keygen -q -b 1024 -N '' -f $keyfile -t dsa","Generating SSH keys for pb");
    3737 }
    3738 
    3739 $keyfile = "$ENV{'HOME'}/.ssh/id_rsa" if (-s "$ENV{'HOME'}/.ssh/id_rsa");
    3740 $keyfile = "$ENV{'HOME'}/.ssh/id_dsa" if (-s "$ENV{'HOME'}/.ssh/id_dsa");
    3741 $keyfile = "$ENV{'HOME'}/.ssh/pb_dsa" if (-s "$ENV{'HOME'}/.ssh/pb_dsa");
    3742 die "Unable to find your public ssh key under $keyfile" if (not defined $keyfile);
    3743 return($keyfile);
    3744 }
    3745 
    3746 
    3747 # Returns the pid of a running VM command using a specific VM file
    3748 sub pb_check_ps {
    3749     my $vmcmd = shift;
    3750     my $vmm = shift;
    3751     my $vmexist = 0;        # FALSE by default
    3752 
    3753     open(PS, "ps auxhww|") || die "Unable to call ps";
    3754     while (<PS>) {
    3755         next if (! /$vmcmd/);
    3756         next if (! /$vmm/);
    3757         my ($void1, $void2);
    3758         ($void1, $vmexist, $void2) = split(/ +/);
    3759         last;
    3760     }
    3761     return($vmexist);
    3762 }
    3763 
    3764 
    3765 sub pb_extract_build_files {
    3766 
    3767 my $src=shift;
    3768 my $dir=shift;
    3769 my $ddir=shift;
    3770 my $mandatory=shift || "spec";
    3771 my @files;
    3772 
    3773 my $flag = "mayfail" if (($mandatory eq "patch") || ($mandatory eq "src"));
    3774 my $res;
    3775 
    3776 if ($src =~ /tar\.gz$/) {
    3777     $res = pb_system("tar xfpz $src $dir","Extracting $mandatory files from $src",$flag);
    3778 } elsif ($src =~ /tar\.bz2$/) {
    3779     $res = pb_system("tar xfpj $src $dir","Extracting $mandatory files from $src",$flag);
    3780 } else {
    3781     die "Unknown compression algorithm for $src";
    3782 }
    3783 # If not mandatory return now
    3784 return() if (($res != 0) and (($mandatory eq "patch") || ($mandatory eq "src")));
    3785 opendir(DIR,"$dir") || die "Unable to open directory $dir";
    3786 foreach my $f (readdir(DIR)) {
    3787     next if ($f =~ /^\./);
    3788     # Skip potential patch dir
    3789     next if ($f =~ /^pbpatch/);
    3790     # Skip potential source dir
    3791     next if ($f =~ /^pbsrc/);
    3792     move("$dir/$f","$ddir") || die "Unable to move $dir/$f to $ddir";
    3793     pb_log(2,"mv $dir/$f $ddir\n");
    3794     push @files,"$ddir/$f";
    3795 }
    3796 closedir(DIR);
    3797 # Not enough but still a first cleanup
    3798 pb_rm_rf("$dir");
    3799 return(@files);
    3800 }
    3801 
    3802 sub pb_list_bfiles {
    3803 
    3804 my $dir = shift;
    3805 my $pbpkg = shift;
    3806 my $bfiles = shift;
    3807 my $pkgfiles = shift;
    3808 my $supfiles = shift;
    3809 # subdir to keep if recursive mode, empty by default
    3810 my $subdir = shift || "";
    3811 # In a recursive function , we need a local var as DIR handle
    3812 my $bdir;
    3813 
    3814 pb_log(2,"DEBUG: entering pb_list_bfiles in $dir: ".Dumper($bfiles)."\n");
    3815 opendir($bdir,"$dir") || die "Unable to open dir $dir: $!";
    3816 foreach my $f (readdir($bdir)) {
    3817     pb_log(3,"DEBUG: pb_list_bfiles found $f\n");
    3818     next if ($f =~ /^\./);
    3819     if (-d "$dir/$f") {
    3820         # Recurse for directories (Debian 3.0 format e.g.)
    3821         pb_log(2,"DEBUG: pb_list_bfiles recurse in $dir/$f\n");
    3822         pb_list_bfiles("$dir/$f",$pbpkg,$bfiles,$pkgfiles,$supfiles,$f);
    3823         next;
    3824     }
    3825 
    3826     my $key = $f;
    3827     # if recursive then store also the subdir
    3828     $key = "$subdir/$f" if ($subdir ne "");
    3829     $bfiles->{$key} = "$dir/$f";
    3830     $bfiles->{$key} =~ s~$ENV{'PBROOTDIR'}~~;
    3831     if (defined $supfiles->{$pbpkg}) {
    3832         $pkgfiles->{$key} = "$dir/$f" if ($f =~ /$supfiles->{$pbpkg}/);
    3833     }
    3834 }
    3835 closedir($bdir);
    3836 pb_log(2,"DEBUG: exiting pb_list_bfiles: ".Dumper($bfiles)."\n");
    3837 }
    3838 
    3839 sub pb_add_coma {
    3840 
    3841 my $str = shift;
    3842 my $addstr = shift;
    3843 
    3844 $str .= "," if (defined $str);
    3845 $str .= $addstr;
    3846 return($str);
    3847 }
    3848 
    3849 sub pb_list_sfiles {
    3850 
    3851 my $sdir = shift;
    3852 my $ptr = shift;
    3853 my $pbos = shift;
    3854 my $extdir = shift;
    3855 
    3856 pb_log(2,"DEBUG: entering pb_list_sfiles: ".Dumper($ptr)."\n");
    3857 my $key = "$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}";
    3858 
    3859 # Prepare local sources for this distro - They are always applied first - May be a problem one day
    3860 # This function works for both patches and additional sources
    3861 foreach my $p (sort(<$sdir/*>)) {
    3862     $ptr->{$key} = pb_add_coma($ptr->{$key},"file://$p") if (($p =~ /\.all$/) || ($p =~ /\.$pbos->{'os'}$/) || ($p =~ /\.$pbos->{'type'}$/) || ($p =~ /\.$pbos->{'family'}$/) || ($p =~ /\.$pbos->{'name'}$/) || ($p =~ /\.$pbos->{'name'}-$pbos->{'version'}$/) ||($p =~ /\.$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}$/));
    3863 }
    3864 
    3865 # Prepare also remote sources to be included - Applied after the local ones
    3866 foreach my $p ("all","$pbos->{'os'}","$pbos->{'type'}","$pbos->{'family'}","$pbos->{'name'}","$pbos->{'name'}-$pbos->{'version'}","$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}") {
    3867     my $f = "$extdir.".".$p";
    3868     next if (not -f $f);
    3869     if (not open(PATCH,$f)) {
    3870         pb_display("Unable to open existing external source file content $f\n");
    3871         next;
    3872     }
    3873     while (<PATCH>) {
    3874         chomp();
    3875         $ptr->{$key} = pb_add_coma($ptr->{$key},"$_");
    3876     }
    3877     close(PATCH);
    3878 }
    3879 pb_log(2,"DEBUG: exiting pb_list_sfiles: ".Dumper($ptr)."\n");
    3880 return($ptr);
    3881 }
    3882    
    3883 #
    3884 # Return the list of packages we are working on in a non CMS action
    3885 #
    3886 sub pb_get_pkg {
    3887 
    3888 my @pkgs = ();
    3889 
    3890 my ($var) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
    3891 @pkgs = keys %$var;
    3892 
    3893 pb_log(0,"Packages: ".join(',',@pkgs)."\n");
    3894 return(\@pkgs);
    3895 }
    3896 
    3897 # Manages VM/RM SSH port communication
    3898 sub pb_get_port {
    3899 
    3900 my $port = shift;
    3901 my $pbos = shift;
    3902 my $cmt = shift;
    3903 my $nport;
    3904 
    3905 die "No port passed in parameter. Report to dev team\n" if (not defined $port);
    3906 # key is project on VM, but machine tuple for RM
    3907 if ($cmt =~ /^RM/i) {
    3908     $nport = $port->{"$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}"};
    3909 } else {
    3910     $nport = $port->{$ENV{'PBPROJ'}};
    3911 }
    3912 pb_log(2,"pb_get_port with $nport\n");
    3913 # Maybe a port was given as parameter so overwrite
    3914 $nport = "$pbport" if (defined $pbport);
    3915 # Maybe in // mode so use the env var set up as an offset to the base port, except when called from send2target for Packages or for RM
    3916 if (($cmt ne "Packages") && ($cmt !~ /^RM/i)) {
    3917     $nport += $ENV{'PBVMPORT'} if ((defined $pbparallel) && (defined $ENV{'PBVMPORT'}));
    3918 }
    3919 pb_log(2,"pb_get_port returns $nport\n");
    3920 return($nport);
    3921 }
    3922 
    3923 sub pb_set_port {
    3924        
    3925 my ($pid,$ident) = @_;
    3926 pb_log(2,"pb_set_port for VM ($pid), id $ident\n");
    3927 $ENV{'PBVMPORT'} = $ident;
    3928 pb_log(2,"pb_set_port sets PBVMPORT in env to $ENV{'PBVMPORT'}\n");
    3929 }
    3930 
    3931 sub pb_set_parallel {
    3932 
    3933 my $vtype = shift;
    3934 
    3935 pb_log(2,"pb_set_parallel vtype: $vtype\n");
    3936 # Take care of memory size if VM, parallel mode and more than 1 action
    3937 if ((defined $pbparallel) && ($pbparallel ne 1) && ($vtype eq "vm")) {
    3938     eval
    3939     {
    3940         require Linux::SysInfo;
    3941         Linux::SysInfo->import();
    3942     };
    3943     if ($@) {
    3944         # Linux::SysInfo not found
    3945         pb_log(1,"ADVISE: Install Linux::SysInfo to benefit from automatic parallelism optimization.\nOr optimize manually pbparallel in your pb.conf file\nUsing $pbparallel processes max at a time for the moment\nWARNING: This may consume too much memory for your system\n");
    3946     } else {
    3947         # Using the memory size
    3948         my $si = Linux::SysInfo::sysinfo();
    3949         if (not defined $si) {
    3950             pb_log(1,"ADVISE: Install Linux::SysInfo to benefit from automatic parallelism optimization.\nOr optimize manually pbparallel in your pb.conf file\nUsing $pbparallel processes max at a time for the moment\nWARNING: This may consume too much memory for your system\n");
    3951         } else {
    3952             # Keep the number of VM whose memory can be allocated
    3953             my $ram = $si->{"totalram"}-$si->{"sharedram"}-$si->{"bufferram"};
    3954             my $ram2;
    3955             my ($vmmem) = pb_conf_get_if("vmmem");
    3956 
    3957             my $v = "default";
    3958             if ((defined $vmmem) and (defined $vmmem->{$v})) {
    3959                 $ram2 = $vmmem->{$v};
    3960             } else {
    3961                 # Default for KVM/QEMU
    3962                 $ram2 = 128;
    3963             }
    3964             $pbparallel = sprintf("%d",$ram/$ram2);
    3965         }
    3966         pb_log(1,"Using $pbparallel processes at a time\n");
    3967     }
    3968 }
    3969 pb_log(2,"pb_set_parallel returns: $pbparallel\n") if (defined $pbparallel);
    3970 return($pbparallel);
    3971 }
    3972 
    3973 sub pb_get_sudocmds {
    3974        
    3975 my $pbos = shift;
    3976 my %sudocmds;
    3977 
    3978 pb_log(2,"pb_get_sudocmds entering with lines:".Dumper(@_)."\n");
    3979 foreach my $c (split(/;/,$pbos->{'update'}),split(/;/,$pbos->{'install'}),@_) {
    3980     pb_log(2,"pb_get_sudocmds analyses $c\n");
    3981     next if ($c !~ /^\s*sudo/);
    3982     # remove sudo and leading spaces
    3983     $c =~ s/^\s*sudo\s+//;
    3984     # keep only the command, not the params
    3985     $c =~ s/([^\s]+)\s.*$/$1/;
    3986     $sudocmds{$c} = "";
    3987 }
    3988 pb_log(2,"pb_get_sudocmds returns ".Dumper(keys %sudocmds)."\n");
    3989 return(keys %sudocmds);
    3990 }
    3991 
    3992 sub pb_sign_pkgs {
    3993 
    3994 my $pbos = shift;
    3995 my $made = shift;
    3996 
    3997 pb_log(2,"entering pb_sign_pkg: $made ".Dumper($pbos)."\n");
    3998 my ($passfile, $passphrase, $passpath) = pb_conf_get_if("pbpassfile","pbpassphrase","pbpasspath");
    3999 $ENV{'PBPASSPHRASE'} = $passphrase->{$ENV{'PBPROJ'}} if ((not defined $ENV{'PBPASSPHRASE'}) && (defined $passphrase->{$ENV{'PBPROJ'}}));
    4000 $ENV{'PBPASSFILE'} = $passfile->{$ENV{'PBPROJ'}} if ((not defined $ENV{'PBPASSFILE'})&& (defined $passfile->{$ENV{'PBPROJ'}})) ;
    4001 $ENV{'PBPASSPATH'} = $passpath->{$ENV{'PBPROJ'}} if ((not defined $ENV{'PBPASSPATH'})&& (defined $passpath->{$ENV{'PBPROJ'}})) ;
    4002 
    4003 # Remove extra spaces
    4004 $made =~ s/\s+/ /g;
    4005 $made =~ s/^\s//g;
    4006 $made =~ s/\s$//g;
    4007 
    4008 if ($pbos->{'type'} eq "rpm") {
    4009     eval
    4010     {
    4011         require RPM4::Sign;
    4012         RPM4::Sign->import();
    4013     };
    4014     if ($@) {
    4015         # RPM4::Sign not found
    4016         pb_log(1,"WARNING: Install RPM4::Sign to benefit from automatic package signing.\n");
    4017     } else {
    4018         return if ((not defined $ENV{'PBPASSPHRASE'}) and (not defined $ENV{'PBPASSFILE'}));
    4019         my $sign = RPM4::Sign->new(
    4020             passphrase => $ENV{'PBPASSPHRASE'},
    4021             name => $ENV{'PBPACKAGER'},
    4022             path => $ENV{'PBPASSPATH'},
    4023             password_file => $ENV{'PBPASSFILE'},
    4024         );
    4025 
    4026         pb_log(0,"Signing RPM packages...\n");
    4027         pb_log(2,"pb_sign_pkg: pkgs:".Dumper(split(/ /,$made))."\n");
    4028         $sign->rpmssign(split(/ /,$made));
    4029     }
    4030 } elsif ($pbos->{'type'} eq "deb") {
    4031     my $changes = "";
    4032     foreach my $c (split(/ /,$made)) {
    4033         $changes .= " $ENV{'PBBUILDDIR'}/$c" if ($c =~ /\.changes$/);
    4034     }
    4035     my $debsigncmd = pb_check_req("debsign",1);
    4036     pb_system("$debsigncmd -m\'$ENV{'PBPACKAGER'}\' $changes","Signing DEB packages");
    4037 } else {
    4038     pb_log(0,"I don't know yet how to sign packages for type $pbos->{'type'}.\nPlease give feedback to dev team\n");
    4039 }
    4040 pb_log(2,"exiting pb_sign_pkg\n");
    4041 }
    4042 
    4043 # return list of all distributins supported, coma separated
    4044 sub pb_get_distros {
    4045 
    4046 my $pbos = shift;
    4047 my $pbtarget = shift;
    4048 
    4049 my $tmpl = "$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'},";
    4050 
    4051 # Get list of distributions for which we need to generate build files if no target
    4052 if (not defined $pbtarget) {
    4053     my @pt = pb_conf_get_if("vmlist","velist","rmlist");
    4054     if (defined $pt[0]->{$ENV{'PBPROJ'}}) {
    4055         $tmpl .= $pt[0]->{$ENV{'PBPROJ'}};
    4056     }
    4057     if (defined $pt[1]->{$ENV{'PBPROJ'}}) {
    4058         # The 2 lists need to be grouped with a ',' separating them
    4059         if ($tmpl ne "") {
    4060             $tmpl .= ",";
    4061         }
    4062         $tmpl .= $pt[1]->{$ENV{'PBPROJ'}}
    4063     }
    4064     if (defined $pt[2]->{$ENV{'PBPROJ'}}) {
    4065         # The lists needs to be grouped with a ',' separating them
    4066         if ($tmpl ne "") {
    4067             $tmpl .= ",";
    4068         }
    4069     $tmpl .= $pt[2]->{$ENV{'PBPROJ'}}
    4070     }
    4071 }
    4072 return($tmpl);
    4073 }   
    4074 
    4075 sub pb_get_extdir () {
    4076 
    4077     # the pbrc file should contain it and whatever the key, we take it
    4078     my ($ed) = pb_conf_read("$ENV{'PBDESTDIR'}/pbrc","pbextdir");
    4079     pb_log(2,"ed: ".Dumper($ed)."\n");
    4080     my $pbextdir = "";
    4081     foreach my $k (keys %$ed) {
    4082         $pbextdir = $ed->{$k};
    4083         # In case we have an empty field, empty it completely
    4084         pb_log(2,"pbextdir: ***$pbextdir***\n");
    4085         $pbextdir =~ s/^\s*$//;
    4086     }
    4087     pb_log(2,"pbextdir: ***$pbextdir***\n");
    4088     return($pbextdir);
    4089 }
    4090 
    4091 1;
     304    # Directory case
     305    if ($debug) {
     306        pb_log(1,"DEBUG: launching $cmd\n");
     307    } else {
     308        pb_system($cmd);
     309        pb_vcs_add($scheme,"$target");
     310        pb_log(0,"INFO: Created $target and added it to your $scheme system\n");
     311    }
     312}
     313pb_log(2,"Exiting cb_busterize\n");
     314}
  • projects/casparbuster/devel/bin/cbusterize

    r1470 r1485  
    1313   --help   |-h         brief help message
    1414   --man            full documentation
    15    --source |-s <file/dir>  directory or file to copy in the CasparBuster tree
     15   --force   |-f            force copy of files, even if they exist
     16   --source |-s <file/dir>  directory or files to copy in the CasparBuster tree (',' separated if many)
     17   --plugin |-p <plugin name>   plugin defining what to copy in the CasparBuster tree (',' separated if many)
    1618   --machine|-m <machine>   machine to consider in the subtree
    1719
     
    4143=item B<--source> I<path>
    4244
    43 Specify the path to the source file or directory to manage with CasparBuster.
     45Specify the path to the source file or directory to manage with CasparBuster. Multiple paths can be specified separated by ','.
     46
     47=item B<--plugin> I<name>
     48
     49Specify the name of the plugin to manage with CasparBuster. Multiple plugins can be specified separated by ','.
     50A plugin defines a set of files (with their mode and owner), a set of directories (with their mode and owner) and a set of scripts to launch once the files are copied remotely.
    4451
    4552=back
     
    102109use CasparBuster::Version;
    103110use CasparBuster::Env;
     111use CasparBuster::Plugin;
    104112#use Cwd 'realpath';
    105113use File::Find;
     
    124132my $plugin = undef;
    125133my $quiet = undef;
     134my $force = undef;
    126135my $log = undef;
    127136my $LOG = undef;
     
    141150    'help|h'      => \$help,
    142151    'quiet|q'     => \$quiet,
     152    'force|f'     => \$force,
    143153    'man'         => \$man,
    144     'log-files|l=s' => \$log,
     154    'logfile|l=s' => \$log,
    145155    'source|s=s'  => \$source,
    146156    'plugin|p=s'  => \$plugin,
     
    176186my %cb;
    177187my $cb = \%cb;
    178 ($cb->{'basedir'},$cb->{'database'},$cb->{'usemachines'},$cb->{'pluginsdir'},$cb->{'cms'}) = pb_conf_get("cbbasedir","cbdatabase","cbusemachines","cbpluginssubdir","cbcms");
     188($cb->{'basedir'},$cb->{'usemachines'},$cb->{'cms'}) = pb_conf_get("cbbasedir","cbusemachines","cbcms");
    179189pb_log(2,"%cb: ",Dumper($cb));
    180190
     
    184194
    185195if (defined $plugin) {
    186     # Load plugin conf
     196    # Load plugins
     197    cb_plugin_load();
    187198}
    188199
     
    190201eval { $basedir =~ s/(\$ENV.+\})/$1/eeg };
    191202
    192 pb_log(1, "DEBUG MODE, not doing anything, just printing\nDEBUG: basedir = $basedir\nDEBUG: source  = $source\n");
    193 pb_log(1, "DEBUG: machine = $machine\n") if (defined ($machine));
     203pb_log(1, "DEBUG MODE, not doing anything, just printing\nDEBUG: basedir = $basedir\n");
     204pb_log(1, "DEBUG: source = $source\n") if (defined $source);
     205pb_log(1, "DEBUG: machine = $machine\n") if (defined $machine);
     206
     207# Use potentially a remote account if defined
     208my $account = undef;
     209my $remote = $machine;
     210($account) = pb_conf_get_if("cbaccount") if (defined $machine);
     211$remote = $account->{$machine}."@".$machine if ((defined $account) && (defined $account->{$machine}));
     212pb_log(1, "DEBUG: remote = $remote\n") if (defined $remote);
    194213
    195214# Create basedir if it doesn't exist
     
    198217        pb_log(1, "DEBUG: Creating recursively directory $basedir\n");
    199218    } else {
    200         pb_mkdir_p($basedir) || die "Unable to recursively create $basedir";
    201     }
    202 }
    203 
     219        pb_mkdir_p($basedir) || die "Unable to recursively create $basedir: $!";
     220    }
     221}
     222
     223if (defined $source) {
     224    foreach my $f (split(/,/,$source)) {   
     225        cb_busterize($f);
     226    }
     227}
     228
     229# Now handle plugins if any
     230my $cbp = ();
     231
     232if (defined $plugin) {
     233    foreach my $p (split(/,/,$plugin)) {   
     234        pb_log(1,"Getting context for plugin $p\n");
     235        $cbp = cb_plugin_get($p,$cbp);
     236        pb_log(2,"cbp: ".Dumper($cbp)."\n");
     237        foreach my $k ((keys %{$cbp->{$plugin}->{'files'}}),(keys %{$cbp->{$plugin}->{'dirs'}})) {
     238            cb_busterize($k);
     239        }
     240    }
     241}
     242
     243sub cb_busterize {
     244
     245my $source = shift;
     246
     247pb_log(2,"Entering cb_busterize source: $source\n");
    204248# Is the source a file or a dir ? Split the source parameter in 2
    205249my $srcdir = undef;
    206250my $srcfile = undef;
    207 # TODO: That should be remote !!
    208 if (-d $source) {
    209     $srcdir = $source;
     251my $cmd = undef;
     252
     253if (not defined $machine) {
     254    if (-d $source) {
     255        $srcdir = $source;
     256    } else {
     257        $srcdir = dirname($source);
     258        $srcfile = basename($source);
     259    }
    210260} else {
    211     $srcdir = dirname($source);
    212     $srcfile = basename($source);
    213     }
     261    $cmd = "ssh -q $remote \'echo \"if [ -d $source ]; then exit 0; else exit -1; fi\" | sudo bash\'";
     262    my $res = pb_system($cmd,"","quiet");
     263    pb_log(2,"DEBUG: Found res = $res\n");
     264    if ($res == 0) {
     265        $srcdir = $source;
     266        pb_log(1,"DEBUG: Found remote dir = $source\n");
     267    } else {
     268        $srcdir = dirname($source);
     269        $srcfile = basename($source);
     270        pb_log(1,"DEBUG: Found remote file = $source\n");
     271    }
     272}
    214273
    215274pb_log(1,"DEBUG: Found srcdir = $srcdir\n");
     
    230289$target = basename($target) if ((not defined $srcfile) && (-d $target));
    231290
    232 # Create target if it doesn't exist
    233 if (not -d $target) {
     291# Create target if it doesn't exist when we have to copy a file
     292if ((not -d $target) && (defined $srcfile)) {
    234293    if ($debug) {
    235294        pb_log(1,"DEBUG: Creating recursively directory $target\n");
    236295    } else {
    237         pb_mkdir_p($target) || die "Unable to recursively create $target";
     296        pb_mkdir_p($target) || die "Unable to recursively create $target: $!";
    238297        pb_vcs_add($scheme,$target);
    239298        pb_log(0,"INFO: Created $target and added it to your $scheme system\n");
     
    242301
    243302# We need to know where to get the content from
    244 my $cmd;
    245303my $cmdopt = "";
    246304
     
    249307
    250308if (defined $machine) {
    251     $cmd = "scp -p -q $cmdopt $machine:$source $target";
     309    $cmd = "scp -p -q $cmdopt $remote:$source $target";
    252310} else {
    253311    $cmd = "cp -p $cmdopt $source $target";
     
    257315if (defined $srcfile) {
    258316    # File case
    259     if (! -f "$target/$srcfile") {
     317    if ((! -f "$target/$srcfile") || (defined $force)){
    260318        if ($debug) {
    261319            pb_log(1,"DEBUG: launching $cmd\n");
     
    270328} else {
    271329    # Directory case
    272     # TODO: if targetlocal dir alredy exists, take the parent
    273330    if ($debug) {
    274331        pb_log(1,"DEBUG: launching $cmd\n");
     
    279336    }
    280337}
     338pb_log(2,"Exiting cb_busterize\n");
     339}
Note: See TracChangeset for help on using the changeset viewer.