5 kx #!/bin/env perl
5 kx
5 kx use FindBin;
5 kx use lib $FindBin::Bin;
5 kx
5 kx use strict;
5 kx use warnings FATAL => 'all';
5 kx
5 kx use IO::Handle;
5 kx use File::Basename;
5 kx use File::Temp;
5 kx use Getopt::Long;
5 kx
5 kx use _kxLab;
5 kx
5 kx #
5 kx # Generate $(TARGET_BUILD_DIR)/.DEVLIST file
5 kx #
5 kx # usage:
5 kx # $0 [options] topdir toolchain hardware flavour
5 kx #
5 kx # where:
5 kx # 'topdir' - is a absolute path to the top directory of checked out branch
5 kx # 'toolchain' - is a TOOLCHAIN name
5 kx # 'hardware' - is a HARDWARE name
5 kx # 'flavour' - is a HARDWARE variant
5 kx #
5 kx
5 kx my (%devices, $devices_file);
5 kx my ($products_dest_dir, $pkglist_file);
5 kx my ($top_dir, $toolchain, $hardware, $flavour, $target_build_dir);
5 kx my ($system_version, $distro_version, $distro_name);
5 kx my ($arch, $products_base_dir);
5 kx
5 kx
5 kx sub usage
5 kx {
5 kx print <<EOF;
5 kx
5 kx Usage: build_devices_list [options] topdir toolchain hardware [flavour]
5 kx Options:
5 kx -a, --arch=<z|j|J>
5 kx - where 'z' is gzip, 'j' is bzip2, and 'J' is xz arcive format;
5 kx
5 kx -p, --products-dir=<DIR>
5 kx - base name of products dir default value is 'products';
5 kx
5 kx Args:
5 kx topdir - is a absolute path to the top of checked out branch;
5 kx toolchain - is a TOOLCHAIN name;
5 kx hardware - is a HARDWARE name.
5 kx flavour - is a HARDWARE variant.
5 kx
5 kx EOF
5 kx exit;
5 kx }
5 kx
5 kx
5 kx #
5 kx # http://permissions-calculator.org
5 kx #
5 kx sub text2spec_mode
5 kx {
5 kx my $tmode = shift;
5 kx my $smode = '0';
5 kx
5 kx foreach my $ugo ( $tmode =~ /^.(.{3})(.{3})(.{3})/ )
5 kx {
5 kx $ugo =~ /[SsTt]/ && ($smode += 1);
5 kx }
5 kx return $smode;
5 kx }
5 kx
5 kx sub text2oct_mode
5 kx {
5 kx my $tmode = shift;
5 kx my $omode = '0';
5 kx
5 kx if( $tmode =~ /^.(.{3})(.{3})(.{3})/ )
5 kx {
5 kx my ($u, $g, $o) = ($1, $2, $3);
5 kx my ($sm, $um, $gm, $om) = (0, 0, 0, 0);
5 kx
5 kx $u =~ /r/ && ($um += 4);
5 kx $u =~ /w/ && ($um += 2);
5 kx $u =~ /x/ && ($um += 1);
5 kx if( $u =~ /s/ ) { $um += 1; $sm += 4; }
5 kx $u =~ /S/ && ($sm += 4);
5 kx
5 kx $g =~ /r/ && ($gm += 4);
5 kx $g =~ /w/ && ($gm += 2);
5 kx $g =~ /x/ && ($gm += 1);
5 kx if( $g =~ /s/ ) { $gm += 1; $sm += 2; }
5 kx $g =~ /S/ && ($sm += 2);
5 kx
5 kx $o =~ /r/ && ($om += 4);
5 kx $o =~ /w/ && ($om += 2);
5 kx $o =~ /x/ && ($om += 1);
5 kx if( $o =~ /t/ ) { $om += 1; $sm += 1;}
5 kx $o =~ /T/ && ($sm += 1);
5 kx
5 kx $omode = $sm . $um . $gm . $om;
5 kx }
5 kx return $omode;
5 kx }
5 kx
5 kx
5 kx
5 kx sub read_devices
5 kx {
5 kx my $tarball = shift;
5 kx my $args;
5 kx my %devs;
5 kx
5 kx $args = "--numeric-owner -" . $arch . "tvf " . $tarball;
5 kx
5 kx my $shell_output = <<`SHELL`;
5 kx tar $args
5 kx exit 0
5 kx SHELL
5 kx
5 kx # | permissions | uid/gid | size | date | time | file
5 kx # ---------------------------+---------------------------+----------------------+--------------+------------------+----------------+---------
5 kx while( $shell_output =~ m!^([\-bcpdlrwxSsTt]{10})[ \t]+([0-9]+)/([0-9]+)[ \t]+([0-9,]+)[ \t]+([\-0-9]{10})[ \t]+([:0-9]{5})[ \t]+(.+)$!gm )
5 kx {
5 kx my $perm = $1;
5 kx my $uid = $2;
5 kx my $gid = $3;
5 kx my $size = $4;
5 kx my $dev = $7;
5 kx
5 kx my ($name, $type, $smode, $mode, $owner, $major, $minor, $start, $inc, $count);
5 kx
5 kx $perm =~ s/^\s+|\s+$//g;
5 kx $uid =~ s/^\s+|\s+$//g;
5 kx $gid =~ s/^\s+|\s+$//g;
5 kx $size =~ s/^\s+|\s+$//g;
5 kx $dev =~ s/^\s+|\s+$//g;
5 kx
5 kx $owner = $uid . ":" . $gid;
5 kx
5 kx $name = "/" . $dev;
5 kx $type = substr($perm, 0, 1);
5 kx $mode = text2oct_mode( $perm );
5 kx
5 kx $type =~ tr/-/f/;
5 kx $smode = text2spec_mode( $perm );
5 kx
5 kx if( ($smode or
5 kx $type eq "b" or $type eq "c" or $type eq "s" or
5 kx $type eq "p" or $uid ne "0" or $gid ne "0"
5 kx ) and $type ne "l"
5 kx )
5 kx {
5 kx
5 kx if( $type eq "b" or $type eq "c" )
5 kx {
5 kx ($major, $minor) = split( /,/, $size );
5 kx $devs{$name} = $type . "\t" . $mode . "\t" . $uid . "\t" . $gid . "\t" . $major . "\t" . $minor;
5 kx }
5 kx else
5 kx {
5 kx $devs{$name} = $type . "\t" . $mode . "\t" . $uid . "\t" . $gid;
5 kx }
5 kx
5 kx }
5 kx }
5 kx return %devs;
5 kx
5 kx }
5 kx
5 kx
5 kx sub get_tarballs_list
5 kx {
5 kx my @tarballs;
5 kx
5 kx if( defined $system_version and defined $distro_version and defined $distro_name )
5 kx {
5 kx my $init_dev_package = $products_dest_dir .
5 kx "/base/init-devices-" .
5 kx $system_version . "-" .
5 kx $toolchain . "-" .
5 kx $distro_name . "-" .
5 kx $distro_version . ".txz";
5 kx if( -f $init_dev_package )
5 kx {
5 kx push @tarballs, $init_dev_package;
5 kx }
5 kx }
5 kx
5 kx while( my $line = <PKGLIST_FILE> )
5 kx {
5 kx
5 kx $line =~ /^$/ and next;
5 kx $line =~ /^#/ and next;
5 kx
5 kx if( $line =~ m!^(.+):(.+):(.+):(.+):(.+):(.+)!gm )
5 kx {
5 kx my $pkg = $4;
5 kx my $tarball = $products_dest_dir . "/" . $pkg;
5 kx push @tarballs, $tarball;
5 kx }
5 kx }
5 kx return @tarballs;
5 kx }
5 kx
5 kx
5 kx #
5 kx # Parse the command line options
5 kx #
5 kx $arch = 'J';
5 kx if( ! GetOptions( 'a=s' => \$arch,
5 kx 'arch=s' => \$arch,
5 kx 'p=s' => \$products_base_dir,
5 kx 'products-dir=s' => \$products_base_dir,
5 kx 'help|h|?' => sub { usage() }
5 kx )
5 kx )
5 kx {
5 kx usage();
5 kx }
5 kx
5 kx # Get the rest of the command line
5 kx my $topdir = shift;
5 kx
5 kx $toolchain = shift;
5 kx $hardware = shift;
5 kx $flavour = shift;
5 kx
5 kx if( $arch eq '' )
5 kx {
5 kx $arch = 'J';
5 kx }
5 kx
5 kx
5 kx if( ! defined $products_base_dir or $products_base_dir eq "" ) { $products_base_dir = "products"; }
5 kx
5 kx if( ! defined $topdir or $topdir eq "" ) { usage; }
5 kx if( ! defined $toolchain or $toolchain eq "" ) { usage; }
5 kx if( ! defined $hardware or $hardware eq "" ) { usage; }
5 kx
5 kx
5 kx if( ! defined $flavour or $flavour eq "" )
5 kx {
5 kx $flavour = "";
5 kx $target_build_dir = "." . $toolchain . "/" . $hardware;
5 kx $products_dest_dir = $topdir . "/dist/" . $products_base_dir . "/" . $toolchain . "/" . $hardware;
5 kx }
5 kx else
5 kx {
5 kx $target_build_dir = "." . $toolchain . "/" . $hardware . "/" . $flavour;
5 kx $products_dest_dir = $topdir . "/dist/" . $products_base_dir . "/" . $toolchain . "/" . $hardware . "/" . $flavour;
5 kx }
5 kx
5 kx # setup $top_build_dir
5 kx $top_dir = $topdir;
5 kx my $build_system = $top_dir . "/build-system";
5 kx
5 kx $system_version = $ENV{SYSTEM_VERSION};
5 kx $distro_version = $ENV{DISTRO_VERSION};
5 kx $distro_name = $ENV{DISTRO_NAME};
5 kx
5 kx _kxLab::system( "mkdir -p $target_build_dir" );
5 kx
5 kx #
5 kx # The HW.pkglist shoul be installed into PRODUCTS_DEST_DIR.
5 kx #
5 kx $pkglist_file = $target_build_dir . "/" . $hardware . ".pkglist";
5 kx $devices_file = $target_build_dir . "/" . ".DEVTABLE";
5 kx
5 kx _kxLab::error( "build_devices_list: $topdir is not a directory" ) if( ! -d $topdir );
5 kx _kxLab::error( "build_devices_list: .pkglist missing: $pkglist_file" ) if ( ! -f $pkglist_file );
5 kx
5 kx
5 kx # open the intput file:
5 kx open(PKGLIST_FILE, "< $pkglist_file") or
5 kx _kxLab::error( "$0: Could not open $pkglist_file file: $!" );
5 kx # open the output file:
5 kx open(DEVICES_FILE, "> $devices_file") or
5 kx _kxLab::error( "build_devices_list: Could not open $devices_file file: $!" );
5 kx
5 kx my @pkgs = get_tarballs_list( $pkglist_file );
5 kx
5 kx # close input file:
5 kx close PKGLIST_FILE;
5 kx
5 kx foreach my $pkg ( @pkgs ) { %devices = (%devices, read_devices( $pkg ) ); }
5 kx
5 kx print DEVICES_FILE "# device table\n\n";
5 kx print DEVICES_FILE "# <name>\t\t<type>\t<mode>\t<uid>\t<gid>\t<major>\t<minor>\t<start>\t<inc>\t<count>\n";
5 kx foreach my $dev ( sort keys %devices )
5 kx {
5 kx #
5 kx # Remove the '.new' file extentsion if present:
5 kx #
5 kx my $fname, my @exts = qw(.new);
5 kx my ($name, $dir, $ext) = fileparse( $dev, @exts );
5 kx if( $ext eq ".new" ) {
5 kx $fname = $dir . $name;
5 kx } else {
5 kx $fname = $dev;
5 kx }
5 kx
5 kx print DEVICES_FILE $fname . "\t\t" . $devices{$dev} . "\n";
5 kx }
5 kx
5 kx print sprintf( "####### There are %d inodes to be created or changed.\n", scalar keys %devices );
5 kx
5 kx # close output file:
5 kx close DEVICES_FILE;
Radix cross Linux Build System
Cross-platform build system is designed to build distributions of different operating systems for a set of target devices
39 Commits
2 Branches
2 Tags