path: root/src/mozclient.pl.in

#!/usr/bin/perl -w

# Copyright (c) 2007-2008 Fabien Tassin <fta@sofaraway.org>
# Description: The 'mozclient' module of mozilla-devscripts
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; either version 2, or (at
# your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

############################################################################

package MozClient;

# This is the main class. It should not be used directly. VCS specific classes
# should be instantiated instead. They inherit from this main class and
# overwrite some methods according to VCS requirements.

use Carp;
use strict;

my $mozclient_dir  = '@DATADIR@'; # Needs to be substituted

chomp($mozclient_dir = `pwd`) if $mozclient_dir eq '@DATADIR@';
my $pkg_conf_dir   = "$mozclient_dir/mozclient";
my $patches_dir    = "$pkg_conf_dir/patches";
my $work_dir       = "mozclient-tmp";
my $nobinonly      = "nobinonly";

my @conf_mandatory = qw(MOZCLIENT_APPNAME MOZCLIENT_FILE MOZCLIENT_GETVERSION
			MOZCLIENT_GETDATE MOZCLIENT_VCS);
my @conf_optional  = qw(MOZCLIENT_MODULES MOZCLIENT_PROJECT MOZCLIENT_BRANCH
			MOZCLIENT_POSTCOCMD MOZCLIENT_EMBEDDED
			MOZCLIENT_WANTMOZDIR MOZCLIENT_WANTPATCH
			MOZCLIENT_DYNTAG MOZCLIENT_DYNTAG_FILES
			MOZCLIENT_CVS_LOC MOZCLIENT_HG_LOC);
my @conf_list      = qw(MOZCLIENT_FILE);

# List of dependencies
my $dependencies = {
  'cvs'       => '/usr/bin/cvs',
  'mercurial' => '/usr/bin/hg',
  'quilt'     => '/usr/bin/quilt',
  'wget'      => '/usr/bin/wget',
};

my $defaults = {
  'MOZCLIENT_CVS_LOC' => ':pserver:anonymous@cvs-mirror.mozilla.org:/cvsroot',
  'MOZCLIENT_HG_LOC'  => 'http://hg.mozilla.org/',
  'MOZCLIENT_EXCLUDE_SCRIPT' => 'remove.binonly.sh',
  'MOZILLA_CLIENT'    => 'mozilla/client.mk',
  'MOZCLIENT_PATCHES' => "$patches_dir",
};

############################################################################

sub new {
  my $class = shift;
  my $conf  = shift;
  my $opt   = shift;

  my $self = {};

  @{$self}{keys %$conf} = values %$conf;

  $self->{'want_branch'} = $$opt{'branch'};
  $self->{'want_listtags'} = 1 if $$opt{'list-tags'};
  $self->{'want_tag'} = $$opt{'tag'};
  $self->{'have_date'} = $$opt{'date'};
  $self->{'preserve_vcs'} = $$opt{'preserve-vcs'};
  $self->{'debug'} = $$opt{'debug'};

  $self->{'want_branch'} = $$conf{'MOZCLIENT_BRANCH'}
    if defined $$conf{'MOZCLIENT_BRANCH'} && !defined $self->{'want_branch'};

  bless($self, $class);
  $self;
}

sub vcs {
  my $self = shift;

  $self->{'MOZCLIENT_VCS'};
}

sub debug {
  my $self = shift;

  $self->{'debug'} = shift if @_;
  $self->{'debug'};
}

sub LOG  {
  my $self = shift;
  my $str = shift;

  printf "LOG: $str\n", @_ if $self->debug;
}

sub LOG2 {
  my $self = shift;
  my $str = shift;

  printf "$str\n", @_;
}

sub check_dependencies {
  my $self = shift;

  $self->LOG("MozClient::check_dependencies()");
  my $missing = [];
  map { push @$missing, $_ unless -x $$dependencies{$_}} keys %$dependencies;
  carp "# Error: missing dependencies. Please install " .
    (join ", ", @$missing) . "\n" if $#$missing >= 0;
  1;
}

sub cleanup_dir {
  my $self = shift;

  if (-d $work_dir) {
    $self->LOG("MozClient::cleanup_dir()");
    $self->exec("rm -rf $work_dir");
  }
}

sub prepare_dir {
  my $self = shift;

  $self->LOG("MozClient::prepare_dir()");
  $self->cleanup_dir();
  $self->mkdir($work_dir, 0755);
}

sub exec {
  my $self = shift;

  $self->LOG2("\$ %s", @_);
  my $cmd = sprintf "%s", @_;
  my $args = &main::_split_args($cmd);
  my $ret = system(@$args);
  $ret == 0 || carp "Can't run '$cmd': error code $ret\n";
}

sub exec2 {
  my $self = shift;

  $self->LOG2("\$ %s", @_);
  my $cmd = shift;
  return `$cmd`;
}

sub chdir {
  my $self = shift;

  $self->LOG2("\$ cd %s", @_);
  my $dir = shift;
  CORE::chdir($dir) || carp "Can't chdir($dir): $!\n";
}

sub unlink {
  my $self = shift;

  $self->LOG2("\$ rm %s", @_);
  my $file = shift;

  CORE::unlink($file) || carp "Can't unlink($file): $!\n";
}

sub mkdir {
  my $self = shift;
  my $dir  = shift;
  my $mode = shift;
  $self->LOG2("\$ mkdir %s", $dir);
  CORE::mkdir($dir, $mode) || carp "Can't mkdir($dir, $mode): $!\n";
}

sub want_list_tags {
  my $self = shift;

  defined $self->{'want_listtags'} && $self->{'want_listtags'};
}

sub list_tags {
  my $self = shift;

  $self->LOG("MozClient::list_tags()");
  die "Error: list_tags() not supported for " . $self->vcs;
}

# Execute the command defined in MOZCLIENT_POSTCOCMD after the checkout
sub do_post_co_commands {
  my $self = shift;

  $self->LOG("MozClient::do_post_co_commands()");
  $self->chdir($work_dir);
  $self->exec2($self->{'MOZCLIENT_POSTCOCMD'});
  $self->chdir("..");
}

sub get_client {
  my $self = shift;

  $self->LOG("MozClient::get_client()");
  die "Can't MozClient::get_client() for " . $self->vcs;
}

sub set_revdate {
  my $self = shift;

  $self->LOG("MozClient::set_revdate()");
  die "Can't MozClient::set_revdate() for " . $self->vcs;
}

sub convert_revdate {
  my $self = shift;

  $self->LOG("MozClient::convert_revdate()");
  die "Can't MozClient::convert_revdate() for " . $self->vcs;
}

sub do_dynamic_tag {
  my $self = shift;

  $self->LOG("MozClient::do_dynamic_tag()");
  die "Error: do_dynamic_tag() not supported for " . $self->vcs;
}

sub setup {
  my $self = shift;

  $self->LOG("MozClient::setup()");
  $self->{'mozclient_date'} = "";
  $self->{'moz_co_tag'} = "";

  if (!defined $self->{'want_tag'} && defined $self->{'MOZCLIENT_DYNTAG'}) {
    $self->do_dynamic_tag();
  }

  if (defined $self->{'want_tag'}) {
    # We want a tag, we can either let mozclient compute the version or
    # specify our own (using -t TAG=version)
    if (defined $self->{'have_date'}) {
      warn "Warning: can't use -d and -t together. Ignoring -d";
      undef $self->{'have_date'};
    }
    $self->{'want_tag'} =~ m/([^=]*)(=?)(.*)/;
    $self->{'ltag'} = $1;
    $self->{'dtag'} = $3;
    $self->{'co_tag'} = "-r $1";
    $self->{'moz_co_tag'} = "MOZ_CO_TAG=$1";
  }
  else {
    # we don't want a specific tag, so go for a date and possibly a branch
    if (!defined $self->{'have_date'}) {
      chomp($self->{'have_date'} = `$self->{'MOZCLIENT_GETDATE'}`);
    }
    $self->{'mozclient_date'} =
      '-D "' . $self->convert_revdate($self->{'have_date'}) . '"';
    $self->{'co_tag'} = '';
    $self->{'co_tag'} =
      "-r " . $self->{'want_branch'} if defined $self->{'want_branch'};
  }
}

sub checkout {
  my $self = shift;

  $self->LOG("MozClient::checkout()");
  die "Can't MozClient::checkout() for " . $self->vcs;
}

sub nobin_cleanup {
  my $self = shift;

  $self->LOG("MozClient::nobin_cleanup()");

  $self->chdir("$work_dir/mozilla");
  my $cmd = sprintf "sh ../../%s > REMOVED+${nobinonly}.txt 2>&1",
    $self->{'MOZCLIENT_EXCLUDE_SCRIPT'};
  $self->exec2($cmd);
  $self->unlink("REMOVED+${nobinonly}.txt")
    unless -s "REMOVED+${nobinonly}.txt";
  $self->chdir("../..");
}

sub tar_exclude {
  my $self = shift;

  $self->LOG("MozClient::tar_exclude()");
  # nothing
  [];
}

sub pack {
  my $self = shift;

  $self->LOG("MozClient::pack()");

  my $tar_exclude = "";
  unless ($self->{'preserve_vcs'}) {
    my $dirs = $self->tar_exclude();

    $tar_exclude = join " ", @$dirs;
  }

  my $tversion;
  if (defined $self->{'want_tag'} &&
      defined $self->{'dtag'} && length $self->{'dtag'} > 0) {
    $tversion = $self->{'dtag'};
  }
  else {
    $self->chdir($work_dir);
    chomp($tversion = `$self->{'MOZCLIENT_GETVERSION'}`);
    $tversion .= '~' . $self->{'MOZCLIENT_VCS'} . $self->{'have_date'}
      unless defined $self->{'want_tag'};
    $self->LOG2("\$ tversion=`" . $self->{'MOZCLIENT_GETVERSION'} .
		"` # => $tversion");
    $self->chdir("..");
  }
  my $version = $tversion;
  $version .= "+${nobinonly}"
    if -f "$work_dir/mozilla/REMOVED+${nobinonly}.txt";
  $self->exec("rm -rf $work_dir/" . $self->{'MOZCLIENT_APPNAME'} .
	      "-$version");
  if ($self->{'MOZCLIENT_EMBEDDED'} || $self->{'MOZCLIENT_WANTMOZDIR'}) {
    $self->mkdir("$work_dir/" . $self->{'MOZCLIENT_APPNAME'} . "-$version",
		 0755);
  }
  if ($self->{'MOZCLIENT_EMBEDDED'}) {
    $self->chdir($work_dir);
    my $cmd = sprintf "tar jcf %s-%s/%s-%s-source.tar.bz2 %s mozilla",
      $self->{'MOZCLIENT_APPNAME'}, $version, $self->{'MOZCLIENT_PROJECT'},
      $tversion, $tar_exclude;
    $self->exec($cmd);
    $self->chdir("..");
  }
  else {
    $self->exec("mv $work_dir/mozilla $work_dir/" .
		$self->{'MOZCLIENT_APPNAME'} . "-$version/");
  }
  $self->unlink($self->{'MOZCLIENT_APPNAME'} . "_$version.orig.tar.gz")
    if -f $self->{'MOZCLIENT_APPNAME'} . "_$version.orig.tar.gz";
  $self->chdir($work_dir);
  my $cmd = sprintf "tar zcf ../%s_%s.orig.tar.gz %s %s-%s",
    $self->{'MOZCLIENT_APPNAME'}, $version, $tar_exclude,
    $self->{'MOZCLIENT_APPNAME'}, $version;
  $self->exec2($cmd);
  $self->chdir("..");
  $self->exec("rm -rf $work_dir");
  $self->exec("ls -l " . $self->{'MOZCLIENT_APPNAME'} .
	      "_$version.orig.tar.gz");
}

############################################################################

package MozClient::CVS;

use vars qw(@ISA);
use strict;

@ISA = ("MozClient");

# Return the list of TAGs known by the VCS for MOZCLIENT_FILE
sub list_tags {
  my $self = shift;

  $self->LOG("MozClient::CVS::list_tags()");
  $self->chdir($work_dir);
  $self->exec("cvs -d " . $self->{'MOZCLIENT_CVS_LOC'} . " co " .
	      (join ' ',  @{$self->{'MOZCLIENT_FILE'}}));
  my $file = ${$self->{'MOZCLIENT_FILE'}}[0];
  $file =~ s,^([^/]*)/,,;
  $self->chdir("$1");
  $self->exec("cvs status -v $file");
  $self->chdir("../..");
}

sub do_dynamic_tag {
  my $self = shift;

  $self->LOG("MozClient::CVS::do_dynamic_tag()");
  # We want a dynamic TAG. Fetch files listed in MOZCLIENT_DYNTAG_FILES, then
  # apply MOZCLIENT_DYNTAG rule to set $want_tag
  die "Error: Missing MOZCLIENT_DYNTAG_FILES\n"
    unless defined $self->{'MOZCLIENT_DYNTAG_FILES'};
  $self->chdir($work_dir);
  my $date = "";
  $date = '-D "' . $self->convert_revdate($self->{'have_date'}) . '"'
    if defined $self->{'have_date'};
  undef $self->{'have_date'};
  my $cmd = sprintf "cvs -d %s co %s", $self->{'MOZCLIENT_CVS_LOC'},
    $self->{'MOZCLIENT_DYNTAG_FILES'};
  $self->exec($cmd);
  chomp($self->{'want_tag'} = `$self->{'MOZCLIENT_DYNTAG'}`);
  $self->LOG2("\$ want_tag=`" . $self->{'MOZCLIENT_DYNTAG'} . "` # => " .
	      $self->{'want_tag'});
  $self->chdir("..");
}

sub get_client {
  my $self = shift;

  $self->LOG("MozClient::CVS::get_client()");
  my $tbranch = defined $self->{'want_branch'} ?
    "-r " . $self->{'want_branch'} : "";

  $self->chdir($work_dir);
  my $cmd = sprintf "cvs -d %s co %s %s %s %s", $self->{'MOZCLIENT_CVS_LOC'},
    $tbranch, $self->{'mozclient_date'}, $self->{'co_tag'},
    $self->{'MOZILLA_CLIENT'};
  $self->exec($cmd);
  $self->chdir("..");

  if (defined $self->{'MOZCLIENT_WANTPATCH'} &&
      $self->{'MOZCLIENT_WANTPATCH'}) {
    $self->exec("ln -s " . $self->{'MOZCLIENT_PATCHES'} .
		" $work_dir/patches");
    $self->chdir($work_dir);
    $self->exec("quilt --quiltrc /dev/null push -a");
    $self->chdir("..");
  }
}

sub convert_revdate {
  my $self = shift;
  my $arg = shift;

  $self->LOG("MozClient::CVS::convert_revdate($arg)");
  $arg =~ s,(....)(..)(..)[rt](..)(..),$1/$2/$3 $4:$5 PST,;
  $arg;
}

sub set_revdate {
  my $self = shift;

  $self->LOG("MozClient::CVS::set_revdate()");

  # We can set a date for CVS
  if (defined $self->{'MOZCLIENT_PROJECT'}) {
    $self->{'mozclient_date'} =
      'MOZ_CO_DATE="' . $self->convert_revdate($self->{'have_date'}) . '"';
  }
  else {
    $self->{'mozclient_date'} =
      '-D "' . $self->convert_revdate($self->{'have_date'}) . '"';
  }
}

sub checkout {
  my $self = shift;

  $self->LOG("MozClient:CVS::checkout:()");
  $self->chdir($work_dir);
  if (defined $self->{'MOZCLIENT_PROJECT'}) {
    my $cmd = sprintf "make -f %s checkout MOZ_CO_PROJECT=%s %s %s",
      $self->{'MOZILLA_CLIENT'}, $self->{'MOZCLIENT_PROJECT'},
      $self->{'mozclient_date'}, $self->{'moz_co_tag'};
    $self->exec($cmd);
  }
  else {
    my $cmd = sprintf "cvs -d %s -q -z 3 co -P -A %s %s %s",
      $self->{'MOZCLIENT_CVS_LOC'}, $self->{'mozclient_date'},
      $self->{'co_tag'}, $self->{'MOZCLIENT_MODULES'};
    $self->exec($cmd);
  }
  $self->chdir("..");
}

sub tar_exclude {
  my $self = shift;

  $self->LOG("MozClient::CVS::tar_exclude()");
  [ '--exclude CVS', '--exclude .cvsignore' ];
}

############################################################################

package MozClient::Mercurial;

use vars qw(@ISA);
use strict;

@ISA = ("MozClient");

sub get_client {
  my $self = shift;

  $self->LOG("MozClient::Mercurial::get_client()");
  # nothing to do
}

sub convert_revdate {
  my $self = shift;
  my $arg = shift;

  $self->LOG("MozClient::Mercurial::convert_revdate($arg)");
  $arg =~ s,^(\d+).*,$1,;
  $arg;
}

sub set_revdate {
  my $self = shift;

  $self->LOG("MozClient::Mercurial::set_revdate()");

  # We can set a revision for hg
  $self->{'mozclient_date'} =
    '-r ' . $self->convert_revdate($self->{'have_date'});
}

sub checkout {
  my $self = shift;

  $self->LOG("MozClient:Mercurial::checkout:()");
  $self->chdir($work_dir);
  my $modules = [];
  if (defined $self->{'MOZCLIENT_PROJECT'}) {
    push @$modules,
      $self->{'MOZCLIENT_HG_LOC'} . $self->{'MOZCLIENT_PROJECT'} . "/";
  }
  else {
    for my $module (@{$self->{'MOZCLIENT_MODULES'}}) {
      push @$modules, (sprintf " %s%s/%s", $self->{'MOZCLIENT_HG_LOC'},
	$self->{'MOZCLIENT_PROJECT'}, $module);
    }
  }
  my $cmd = sprintf "hg clone %s %s mozilla", $self->{'mozclient_date'},
    join " ", @$modules;
  $self->exec($cmd);
  $self->chdir("..");
}

sub tar_exclude {
  my $self = shift;

  $self->LOG("MozClient::Mercurial::tar_exclude()");
  [ '--exclude .hg' ];
}

############################################################################

package main;

use strict;
use Getopt::Long qw(:config no_auto_abbrev no_ignore_case
		    require_order bundling);

sub help {
  print <<EOF;
mozclient [-b branch] [-t tag] [-d YYYYMMDDtHHmm] project-name
mozclient [-l] project-name
  --list-tags|-l       list VCS tags
  --branch|-b branch   checkout from a specific branch
  --date|-d date       checkout by date (YYYYMMDDtHHmm)
  --tag|-t tag         checkout using a tag
  --tag|-t tag=ver     checkout using a tag, hard-coding the version
  --preserve-vcs|-p    preserve VCS files
  --debug|-D           increase debug level

 Examples:
   mozclient.pl nspr
    => nspr_4.7.2~beta+1.9~cvs20080516t2119.orig.tar.gz

   mozclient.pl --date 20080101t0000 nspr
    => nspr_4.7~beta+1.9b3~cvs20080101t0000.orig.tar.gz

   mozclient.pl --tag FIREFOX_3_0rc1_RELEASE nspr
    => nspr_4.7.1+1.9.orig.tar.gz

   mozclient.pl --tag FIREFOX_3_0rc1_RELEASE=1.2.3 nspr
    => nspr_1.2.3.orig.tar.gz
EOF
  exit(0);
}

sub _split_args {
  my $str = shift;

  # We want to split words and quoted strings by blanks
  my @data;
  while (length($str)) {
    $str =~ m/^\s/ && do {
      $str =~ s/^\s+//;
      1;
    } ||
    $str =~ m/^'/ && do {
      $str =~ s/^'(.*?)'//;
      push @data, $1;
      1;
    } ||
    $str =~ m/^"/ && do {
      $str =~ s/^"(.*?)"//;
      push @data, $1;
      1;
    } ||
    $str =~ m/^\S+=".*?"/ && do {
      $str =~ s/^(\S+)="(.*?)"//;
       push @data, "$1=$2";
      1;
    } || do {
      $str =~ s/^(\S+)//;
      push @data, $1;
    };
  }
  return \@data;
}

# Read the project conf file
sub read_project_file {
  my $pkg = shift;

  my $file = sprintf "%s/%s.conf", $pkg_conf_dir, $pkg;
  my $data = {};
  open(CONF, "$file") || die "Can't open $file: $!\n";
  while (defined (my $line = <CONF>)) {
    $line =~ s/([^\\])#.*/$1/; # drop comments, but not \#
    $line =~ s/(^\s+|\s+$)//;
    next if $line =~ m/^#/;
    next if $line =~ m/^\s*$/;
    $line =~ m/^(\S+)\s*=\s*(.*)/;
    $$data{$1} = defined $2 && length($2) ? $2 : undef;
  }
  close CONF;
  # Check all mandatory keywords/variables are there
  my $missing = [];
  my $extra = [];
  my $opts = {};
  map { $$opts{$_} = 1 } @conf_mandatory, @conf_optional;
  map { push @$extra, $_ unless defined $$opts{$_} } keys %$data;
  map { push @$missing, $_ unless defined $$data{$_} } @conf_mandatory;
  if ($#$extra >= 0) {
    die "# Error in $file: unknown keywords found: " .
      (join ", ", @$extra) . "\n";
  }
  if ($#$missing >= 0) {
    die "# Error in $file: mandatory keywords missing: " .
      (join ", ", @$missing) . "\n";
  }
  # Set default values
  map { $$data{$_} = $$defaults{$_} unless defined $$data{$_} }
    keys %$defaults;
  # Transform into lists arguments that are supposed to be lists
  map { $$data{$_} = _split_args($$data{$_}) if defined $$data{$_} }
    @conf_list;

  return $data;
}

############################################################################

# Main
my $opt = {};
GetOptions($opt,
	   'debug|D+',
	   'list-tags|l',
	   'branch|b=s',
	   'date|d=s',
	   'tag|t=s',
	   'preserve-vcs|p') || &help();

&help() unless $#ARGV >= 0;

my $conf = &read_project_file(shift @ARGV);

my $client;
my $vcs = $$conf{'MOZCLIENT_VCS'};
$vcs eq 'cvs' && do { $client = MozClient::CVS->new($conf, $opt);       1; } ||
$vcs eq 'hg'  && do { $client = MozClient::Mercurial->new($conf, $opt); 1; } ||
do {
  die "VCS '$$conf{'MOZCLIENT_VCS'}' not supported yet";
};

$client->check_dependencies();
$client->prepare_dir();

if ($client->want_list_tags) {
  $client->list_tags();
  $client->cleanup_dir();
  exit(0);
}

$client->setup();

# We need the mozilla client if we want to fetch a project
$client->get_client() if defined $client->{'MOZCLIENT_PROJECT'};

# We also want to checkout using a date or a revision to avoid been
# caught in mid-air with another commit, unless a tag is requested
$client->set_revdate() unless defined $client->{'want_tag'};

if (!defined $client->{'have_date'} && !defined $client->{'want_tag'}) {
  die "Error: neither date nor tag found.  Did getdate failed ?";
}

# Finally do the real checkout
$client->checkout();

# Do post-co commands if we have to
$client->do_post_co_commands() if defined $client->{'MOZCLIENT_POSTCOCMD'};

# Remove binary only files and preserve a log file if we indeed removed
# something. In case we didn't, drop the log file
$client->nobin_cleanup();

# Create the tarball
$client->pack();