api_manager

platform file from motorola kernel code

#!/usr/bin/env perl

# The source files are wholly original Motorola proprietary work now being 
# licensed as BSD, the following Copyright Notice will be added to each source 
# code file, documentation and other materials with the distribution:
# 
#       Copyright  2006, Motorola, All Rights Reserved.
# 
# This program is licensed under a BSD license with the following terms:
# 
# Redistribution and use in source and binary forms, with or without 
# modification, are permitted provided that the following conditions are met:
#
# - Redistributions of source code must retain the above copyright notice, 
#   this list of conditions and the following disclaimer. 
#
# - Redistributions in binary form must reproduce the above copyright notice, 
#   this list of conditions and the following disclaimer in the documentation 
#   and/or other materials provided with the distribution. 
#
# - Neither the name of the MOTOROLA nor the names of its contributors may be 
#   used to endorse or promote products derived from this software without 
#   specific prior written permission.
#
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE 
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 
# POSSIBILITY OF SUCH DAMAGE.
#

# Unbuffer Standard Output
$| = 1;

use 5.006;
use strict;
use File::Basename;

our $Root;
BEGIN {
    my $dir = dirname($0);
    $Root = ($dir eq '.' || $dir eq '..') ? $dir.'/..' : dirname($dir);
}

use lib "$Root/lib";
use Bom::Parser::Fspath;
use File;
use Exception;
use crtouch;

my %Actions = (
	install   => \&install,
	uninstall => \&uninstall,
);

my $Errs;
my $WarnViewPathnames;         # for warnings about /view/ pathnames

my $action = shift;
my $func = $Actions{$action};
die("unknown action: $action\n") unless defined($func);
my $parser = Bom::Parser->new;
$func->($parser,@ARGV);

if ($WarnViewPathnames) {
    warn("WARNING: $WarnViewPathnames /view/ path(s).  These must be eliminated. \n");
}

exit(1) if $Errs;

sub install {
	my ($parser,$apifile,$props,@items) = @_;
	my $props_dict = Bom::Parser->new->dict($props);
	(my $reltop = $props_dict->{BUILDTOP}) =~ s{/build/}{/components/}o;
	my $dir;

	my $manifest;
	my %avoid = map { $_ => 1 } split(' ',$props_dict->{AVOID_BUILD});

	while (@items) {
		my $path = shift(@items);

		if ($path eq '-dir') {
			$dir = shift(@items);
			# add a / after the last dir for easy parsing of the short name
			# ie. turns $(API_DIR)/include into $(API_DIR)//include
			$dir =~ s{^(.*/)}{$1/}o;
			next;
		} elsif (!defined($dir)) {
			die("no -dir set!");
		}

		my ($prefix) = ($path =~ m{/(/.*)/}o);
		my $install_dir = $dir.$prefix;
		my $item = basename($path);

		if ($avoid{api}) {
			# intended to catch libraries
			unless ($path =~ s{/build/}{/components/}o) {
				# intended to catch includes
				$path = join('/',$reltop,basename($dir).$prefix,$item);
			}

			# FIXME: this looks like some nasty hack?
			if ($path =~ /^(.*)\.so$/o) {
				my @versions = glob("$1*.so.*");
				$path = $versions[-1] if @versions;
			}
		}

		try {
			install_api($parser,$install_dir,$path);
		} onError {
			print($@);
			$Errs++;
		};
	}

	$parser->write_bom($apifile);
	();
}

sub install_api {
	my ($parser,$install_dir,$path) = @_;

	# link the item into the api dir
	my $item = basename($path);
	my $link = "$install_dir/$item";

	# create the install dir
	File::mkpath($install_dir) unless (-d $install_dir);
	# be overly-cautious and re-chmod the base dir	
	chmod 0775, $install_dir;

	# read it so we link the config record
	crtouch($path);

	makelink($parser,$path,$link);

    if ($path =~ /^\/view\//o) {
        # Currently a warning 
        warn("WARNING: path has /view/ prefix: $path\n");
        $WarnViewPathnames++;
    }
	
	# for shared libs, also generate versioned symlinks
	# ie. for libx.so.1.2.3: link libx.so.1.2, libx.so.1 to libx.so.1.2.3
	if ($item =~ /^.*\.so(\.\d+)+$/o) {
		my $ver_link = $link;
		while ($ver_link =~ s/\.\d+$//o) {
			makelink($parser,$link,$ver_link,1);
		}
	}

	(my $short_item = $link) =~ s{^.*//}{}o;
	print("Installed $short_item\n");

	();
}

sub makelink {
	my ($parser,$item,$link,$forcelink) = @_;

	if (my $dup = $parser->get_entry($link)) {
		my $ino1 = File::stat($link,'ino');
		my $ino2 = File::stat($dup->path,'ino');
		die("ERROR: duplicate differing export of $item\n") if ($ino1 != $ino2);
		warn("WARNING: duplicate identical export of $item\n");
		return;
	}

	# FIXME: need to eliminate unlink as it masks duplicate api exports!
	if (lstat($link)) {
		print("WARNING: This item may be a duplicate api export!\n");
		File::unlink($link);
	}

	if ($parser->dict_key('API_COPY') && !$forcelink) {
		File::copy($item,$link);
	} else {
		File::symlink($item,$link);
	}

	# create a new bom entry and add it to the bom parser
	my ($type) = ($link =~ m{//([^/]+)}o);
	my $entry = Bom::Entry->new($link);
	$entry->set_attr(
		api_exported  => 1,
		api_type      => $type,
		api_item      => $item,
		api_signature => signature($link),
	);
	$parser->add_entry($entry);

	();
}

sub uninstall {
	my ($parser,$apifile) = @_;
	return unless (-e $apifile);

	$parser->read_bom($apifile);
	my $entries = $parser->all_entries;

	foreach my $path (sort(keys(%$entries))) {
		# skip items that don't exist
		next unless (-l $path);

		# if the signatures don't match, then some other component has
		# likely installed the api now, so leave it there
		my $signature = $entries->{$path}->get_attr('api_signature');
		next unless ($signature eq signature($path));

		# remove the item
		(my $item = $path) =~ s{^.*//}{}o;
		print("Uninstalling $item\n");
		chmod 0775, $path;
		File::unlink($path);
	}
	chmod 0775, $apifile;
	File::unlink($apifile);
	();
}

sub signature { sprintf('%x:%x',File::lstat($_[0],'ino','ctime')) }