repomgr

   1 #! /usr/bin/perl -W
   2
   3 use strict;
   4
   5 my %modules =
   6  (
   7    repomgr => { paths => [ qw(repomgr conf/repomgr) ] },
   8
   9    bid => { paths => [ qw(l4/Makefile
  10                           l4/BENCHMARKING
  11                           l4/COPYING-GPL-2
  12                           l4/COPYING-LGPL-2.1
  13                           l4/LICENSING
  14                           l4/mk
  15                           l4/conf
  16                           l4/pkg/Makefile
  17                           l4/pkg/README
  18                           l4/tool/Makefile
  19                           l4/tool/gendep
  20                           l4/tool/kconfig
  21                           l4/tool/vim
  22                           l4/tool/lib
  23                           l4/tool/elf-patcher
  24                          ) ]
  25           },
  26
  27    toolbin => { paths => [ map { "l4/tool/bin/$_" }
  28                            qw(isocreator qemu-x86-launch ux-launch
  29                               gengrub1iso gengrub2iso entry-selector
  30                               mkspafs
  31                              ) ]
  32               },
  33
  34    l4re => { paths => [ map { "l4/pkg/$_" } qw(
  35                          boehm_gc bootstrap crtn cxx cxx_libc_io cxx_thread
  36                          drivers hello
  37                          ldscripts
  38                          l4re l4re_c l4re_kernel l4re_vfs l4sys l4util
  39                          ldscripts ldso
  40                          libc_backends libkproxy libloader
  41                          libsigma0
  42                          libstdc++-headers libstdc++-v3 libstdc++-v3_r
  43                          libsupc++ libsupc++_r
  44                          libvbus loader log lua moe ned sigma0
  45                          uclibc uclibc_r
  46                         ) ],
  47              pub_module => 1,
  48              modules => [ qw(bid toolbin) ],
  49            },
  50
  51    examples => {
  52      paths => [ qw(l4/pkg/hello),
  53                 map { "l4/pkg/examples/$_" }
  54                 qw(Makefile
  55                    Control
  56                    sys
  57                    clntsrv
  58                    misc/Makefile
  59                    misc/cat
  60                    misc/reboot
  61                    misc/eb_leds
  62                    misc/shared-hello
  63                    libs/Makefile
  64                    libs/inputtst
  65                    libs/libc_thread_safe
  66                    libs/l4re
  67                    libs/libgomp
  68                    libs/libio
  69                    libs/libirq
  70                    libs/libpng
  71                    libs/rtc
  72                    libs/shmc
  73                  ) ],
  74    },
  75
  76    doc => { paths => [ qw(l4/doc/Makefile l4/doc/source) ], },
  77
  78    l4re_snapshot =>  {
  79      paths => [ map { "l4/pkg/$_" }
  80                 qw(acpica
  81                    ankh
  82                    arm_drivers
  83                    boost-lite
  84                    cunit
  85                    dash
  86                    demangle
  87                    dde
  88                    dde-libinput
  89                    dope
  90                    expat2
  91                    fb-drv
  92                    fbterminal
  93                    fuxfprov
  94                    hello
  95                    input
  96                    io
  97                    l4con
  98                    lib_vt100
  99                    libbsd
 100                    libbsd-full
 101                    libevent
 102                    libc_be_stdin
 103                    libcrypto
 104                    libevent
 105                    libexec
 106                    libgfxbitmap
 107                    libgomp
 108                    libio
 109                    libio-io
 110                    libirq
 111                    libjpeg
 112                    libpng
 113                    libsdl
 114                    libsdl-image
 115                    linux-26-headers
 116                    lxfuxlibc
 117                    mag
 118                    mag-gfx
 119                    ocaml
 120                    ocaml_toys
 121                    python
 122                    readline
 123                    rtc
 124                    scout
 125                    scout-gfx
 126                    serial-drv
 127                    shmc
 128                    slab
 129                    spafs
 130                    sqlite
 131                    tlsf
 132                    tmpfs
 133                    valgrind
 134                    x86emu
 135                    zlib
 136                    ) ],
 137      modules => [ qw(l4re examples doc toolbin) ] },
 138
 139    l4re_all => { paths   => [ qw(l4/pkg l4/tool) ],
 140                  modules => [ qw(l4re_snapshot) ] },
 141
 142    preprocess => {
 143       paths => [ qw(tools/preprocess) ]
 144    },
 145
 146    fiasco => {
 147       pub_module => 1,
 148       paths   => [ qw(kernel/fiasco/BENCHMARKING
 149                       kernel/fiasco/COPYING
 150                       kernel/fiasco/MAINTAINER
 151                       kernel/fiasco/Makefile
 152                       kernel/fiasco/README
 153                       kernel/fiasco/src
 154                       kernel/fiasco/tool
 155                      ) ],
 156       modules => [ qw(preprocess) ],
 157    },
 158
 159    kernel => {
 160       paths => [ qw(kernel/Makefile) ],
 161    },
 162
 163    grub => {
 164       paths => [ qw(grub) ],
 165    },
 166
 167    remote_repo_l4re => {
 168       modules => [ qw(l4re_snapshot) ],
 169    },
 170
 171    remote_repo => { modules => [ qw(fiasco remote_repo_l4re) ], },
 172
 173    all => {
 174       modules => [ qw(remote_repo) ],
 175    },
 176  );
 177
 178 my %commands;
 179
 180 sub get_root_url()
 181 {
 182   my $o = `svn info --xml .`;
 183   die "Failed 'svn info'." if $?;
 184   $o =~ /<root>(.+)<\/root>/m;
 185   $1;
 186 }
 187
 188 sub merge_modules
 189 {
 190   my %paths;
 191
 192   sub do_merge
 193   {
 194     my $pathsref = shift;
 195     my $count = shift;
 196
 197     die "Possible looping in modules structure detected!" unless $count;
 198
 199     foreach my $m (@_)
 200       {
 201         die "Unknown module '$m' referenced!" unless defined $modules{$m};
 202         $$pathsref{$_} = 1 foreach @{$modules{$m}{paths}};
 203         do_merge($pathsref, $count - 1, @{$modules{$m}{modules}});
 204       }
 205   }
 206
 207   do_merge(\%paths, 20, scalar @_ ? @_ : 'all');
 208
 209   sort keys %paths;
 210 }
 211
 212 sub usage
 213 {
 214   my $command = shift;
 215
 216   # check alias
 217   $command = $commands{$command}{alias}
 218     if defined $command and defined $commands{$command}{alias};
 219
 220   if (!defined $command or $command eq 'help')
 221     {
 222       print "$0 command [option]\n";
 223
 224       print "Available commands, use '$0 help command' for help on the command:\n";
 225       foreach (sort keys %commands)
 226         {
 227           print "  $_\n" if defined $commands{$_}{public};
 228         }
 229     }
 230   elsif ($command eq 'update')
 231     {
 232       print "  'update' will update in the following way:\n".
 233             "      update itself and re-exec if necessary\n".
 234             "      call 'make update' in l4/pkg\n".
 235             "      call 'svn update' every directory in kernel\n";
 236     }
 237   elsif ($command eq 'checkout')
 238     {
 239       print "  'checkout' will check out the given modules.\n";
 240       print "Available modules:\n";
 241       foreach (sort keys %modules)
 242         {
 243            print "  $_\n" if $modules{$_}{pub_module};
 244         }
 245     }
 246   else
 247     {
 248       print "  No such command '$command'.\n";
 249     }
 250 }
 251
 252 sub check_module_structure()
 253 {
 254   # make sure the paths look ok
 255   foreach (merge_modules())
 256     {
 257       die "Trailing /'s in modules structure" if /\/$/;
 258       die "Double // detected in modules structure" if /\/\//;
 259     }
 260 }
 261
 262 sub command_help
 263 {
 264   usage(@_);
 265 }
 266
 267 sub command_update
 268 {
 269   print "XXX: todo\n";
 270 }
 271
 272 sub command_root
 273 {
 274   my $url = shift;
 275   my $dirname = shift;
 276   die "Need to give URL" unless defined $url and defined $dirname;
 277   system("svn co $url --depth empty $dirname");
 278 }
 279
 280 sub init_config($)
 281 {
 282   my $config_blob = shift;
 283   $config_blob = '{}' unless defined $config_blob;
 284   my $c;
 285   unless ($c = eval($config_blob))
 286     {
 287       die "Couldn't parse config file: $@" if $@;
 288       die "Couldn't do config file: $!" if $!;
 289       die "Couldn't run config file";
 290     }
 291
 292   my %a = %$c;
 293
 294   $a{base} = "trunk" unless defined $a{base};
 295
 296   return %a;
 297 }
 298
 299 sub convert_path($$%)
 300 {
 301   my $p = shift;
 302   my $partmatch = shift;
 303   my %path_roots = @_;
 304
 305   $p =~ s/^\.\///;
 306   $p .= '/';
 307   foreach my $key (keys %path_roots)
 308     {
 309       my $r = $key;
 310       $r .= '/' unless $r =~ /\/$/;
 311       if ($partmatch)
 312         {
 313           # for partly matches we also need to return the modified path
 314           # because otherwise we can't really know
 315           if ($p =~ /^($r)(.*)$/)
 316             {
 317                my $s = $path_roots{$key}.'/'.$2;
 318                # strip off last / again, it's just used for matching
 319                return substr($s, 0, length($s) - 1);
 320             }
 321         }
 322       else
 323         {
 324           return $path_roots{$key} if $p =~ /^$r$/;
 325         }
 326     }
 327   undef;
 328 }
 329
 330 sub do_checkout(%)
 331 {
 332   my %args = @_;
 333   unless (defined ${$args{mods}}[0])
 334     {
 335       print "Supply module to check out.\n";
 336       usage("checkout");
 337       exit 1;
 338     }
 339
 340   die "Current directory is no SVN WC" unless -d ".svn";
 341
 342   my $root_url = get_root_url();
 343
 344   my $rev = $ENV{REPOMGR_SVN_REV} || 'HEAD';
 345
 346   my @paths = merge_modules(@{$args{mods}});
 347
 348   foreach my $paths (@paths)
 349     {
 350       my @path_elems = split /\/+/, $paths;
 351       my $last_elem = pop @path_elems;
 352       my $path = '.';
 353
 354       foreach my $pe (@path_elems)
 355         {
 356           if (! -d "$path/$pe/.svn")
 357             {
 358               # if we find something from path_roots then switch to that
 359               my $changed_path = convert_path("$path/$pe", 0,
 360                                               %{$args{conf}{path_roots}});
 361
 362               print "Creating $path/$pe\n";
 363               print "   from $changed_path\n" if defined $changed_path;
 364
 365               # there's some other little problem with the 'depth' thing
 366               # when we do checkout some specific list of files (and dirs),
 367               # we need to use depth=empty so that we only get those
 368               # specific files out of the directory, on the other side we'd
 369               # (probably) like to have updates on the directory contents
 370               # when we do 'svn up' which would would with depth=files (or
 371               # infinite)
 372               # As the first thing is merely only needed when doing a
 373               # checkout for another repo... let's have a config option.
 374               my $depth = 'files';
 375               $depth = 'empty' if defined $ENV{REPOMGR_EXACT_CHECKOUT};
 376
 377               if (defined $changed_path)
 378                   {
 379                     my $cmd = "cd $path && svn co -r $rev --depth empty $root_url/$changed_path $pe";
 380                     #print "cmd: $cmd\n";
 381                     system($cmd);
 382                     die "svn co failed" if $?;
 383                   }
 384                 else
 385                   {
 386                     my $cmd = "cd $path && svn update -r $rev --depth empty $pe";
 387                     #print "cmd: $cmd\n";
 388                     system($cmd);
 389                     die "svn update failed" if $?;
 390                   }
 391             }
 392           $path .= '/'.$pe;
 393         }
 394     }
 395
 396   print "Getting sources\n";
 397   my $c = "svn update -r $rev --set-depth infinity ".join(' ', map { s/^\/+//; $_; } @paths);
 398   #print "cmd: $c\n";
 399   system($c);
 400   die "svn update failed" if $?;
 401 }
 402
 403 sub read_file($)
 404 {
 405   my $fn = shift;
 406   return undef unless defined $fn;
 407   my $blob;
 408   if ($fn =~ /^(file|svn|ssh\+svn):\/\//)
 409     {
 410       $blob = `svn cat $fn`;
 411       undef $blob if $?;
 412     }
 413   elsif (open(A, $fn))
 414     {
 415       local undef $/;
 416       $blob = <A>;
 417       close A;
 418     }
 419   $blob;
 420 }
 421
 422 sub command_checkout
 423 {
 424   my %conf = init_config(read_file("l4/conf/repomgr.conf"));
 425   do_checkout(conf => { %conf }, mods => [ @_ ]);
 426 }
 427
 428 sub fix_repomgr_path(%)
 429 {
 430   my %conf = @_;
 431   # fix the path to the repomgr...
 432   @{$modules{repomgr}{paths}} = map { "$conf{repomgr_prefix}/$_" } @{$modules{repomgr}{paths}}
 433     if defined $conf{repomgr_prefix};
 434 }
 435
 436 sub command_init
 437 {
 438   my $repo_root = shift;
 439   my $repo_conf = '';
 440   my $localdir  = 'src';
 441
 442   while (defined $_[0] && ($_[0] eq '-c' or $_[0] eq '-l'))
 443     {
 444       if ($_[0] eq '-c')
 445         {
 446           $repo_conf = $_[1];
 447           shift; shift;
 448         }
 449       elsif ($_[0] eq '-l')
 450         {
 451           $localdir = $_[1];
 452           shift; shift;
 453         }
 454     }
 455
 456   die "Usage: $0 init <REPOROOTURL> [-c <REPOCONFPATH>] [-l <LOCALDIR>] modules..."
 457     if    not defined $repo_root or not defined $repo_conf
 458        or not defined $localdir;
 459
 460   # for absolute path we assume a local config file, good for testing
 461   my $confblob;
 462   if ($repo_conf ne '')
 463     {
 464       if ($repo_conf =~ /^\//)
 465         {
 466           $confblob = read_file($repo_conf);
 467           die "Cannot open '$repo_conf': $!" unless defined $confblob;
 468         }
 469       else
 470         {
 471           my $cmd = "svn cat $repo_root\/$repo_conf";
 472           $confblob = `$cmd`;
 473           die "Command '$cmd' failed" if $?;
 474         }
 475     }
 476
 477   my %conf = init_config($confblob);
 478
 479   ($localdir = $conf{base}) =~ s/.*\/// unless defined $localdir;
 480   print "localdir: $localdir\n";
 481
 482   my $cmd = "svn co --depth empty $repo_root/$conf{base} $localdir";
 483   system($cmd);
 484   die "Command '$cmd' failed" if $?;
 485   chdir $localdir;
 486
 487   fix_repomgr_path(%conf);
 488   do_checkout(conf => { %conf }, mods => [ "repomgr", @_ ]);
 489 }
 490
 491 sub command_modules
 492 {
 493   foreach (sort keys %modules)
 494     {
 495       print "$_\n" if defined $modules{$_}{pub_module};
 496     }
 497 }
 498
 499 sub command_list
 500 {
 501   print "$_\n" foreach merge_modules(@_);
 502 }
 503
 504 sub command_listmapped
 505 {
 506   my $blob = read_file(shift);
 507   die "Need config" unless defined $blob;
 508   my %conf = init_config($blob);
 509   fix_repomgr_path(%conf);
 510   print join("\n", map {
 511                          my $p = convert_path($_, 1, %{$conf{path_roots}});
 512                          defined $p ? $p : $_;
 513                        } merge_modules(@_));
 514   print "\n";
 515 }
 516
 517 %commands =
 518  (
 519    help      => { func => \&command_help, },
 520    init      => { func => \&command_init, },
 521    update    => { func => \&command_update, },
 522    up        => { func => \&command_update, alias => 'update' },
 523    checkout  => { func => \&command_checkout, public => 1},
 524    co        => { func => \&command_checkout, alias => 'checkout'},
 525    modules   => { func => \&command_modules, public => 1},
 526    list      => { func => \&command_list, },
 527    listmapped=> { func => \&command_listmapped, },
 528    root      => { func => \&command_root, },
 529  );
 530
 531 # ----------------------------------------------------------------
 532
 533 check_module_structure();
 534
 535 my $command = shift;
 536
 537 unless (defined $command)
 538   {
 539     usage();
 540     exit 1;
 541   }
 542
 543 if (defined $commands{$command})
 544   {
 545     &{$commands{$command}{func}}(@ARGV);
 546   }
 547 else
 548   {
 549     print "Unknown command '$command'.\n";
 550     usage();
 551     exit 1;
 552   }