Unmask script

unmask (text/plain), 5.60 KB, created by Jason Rhinelander on 2003-03-21 14:54:17 UTC

#!/usr/bin/perl

BEGIN { $> and exec("sudo $0") || die "You are not root, and sudo is not installed\n" }

use 5.006;
use strict;

use constant OP      => 0;
use constant VERSION => 1;
use constant UNMASK  => 2;
use constant NAME    => 3;
use constant MATCH   => 4;

my $emerge_info = `emerge info`;
my ($portdir) = $emerge_info =~ /^PORTDIR="([^"]+)"$/m;
my ($portdir_overlay) = $emerge_info =~ /^PORTDIR_OVERLAY="([^"]+)"$/m;

my $Local_Mask_Path = "$portdir_overlay/profiles/package.mask";
my $Real_Mask_Path = "$portdir/profiles/package.mask";

unless ($portdir_overlay and -f $Local_Mask_Path) {
    die <<ERROR;
Unable to locate your local package.mask file.  Ensure that you have enabled
PORTDIR_OVERLAY in /etc/make.conf, and created a profiles/package.mask file in
that directory
ERROR
}
unless ($portdir and -f $Real_Mask_Path) {
    die "Unable to locate your package.mask file.  An `emerge rsync' may help.\n";
}

my $pkgs = get_local_packages();
update_real_packages($pkgs);
append_leftover($pkgs);



sub update_real_packages {
    my $pkgs = shift;
    local ($^I, @ARGV) = ('', $Real_Mask_Path);
    while (<>) {
        my $cp = $_;
        $cp =~ s/#.*//;
        $cp =~ s/\s+//g;
        unless (length $cp) {
            print;
            next;
        }
        my ($version, $op, $name) = parse_package($cp);
        for my $p (@$pkgs) {
            next unless $p->[NAME] eq $name;
            if ($_ eq "$p->[OP]$p->[NAME]-$p->[VERSION]\n" and not $p->[UNMASK]) { # simple case
                $p->[MATCH]++;
                next;
            }
            my $cmp = versioncmp($version, $p->[VERSION]);
            if (inrange($op, $p->[OP], $cmp)) {
                $p->[MATCH]++;
                if ($p->[UNMASK]) {
                    warn "Unmasking $_";
                    print "# Unmasked by $0\n";
                    $_ = "#$_";
                }
                else {
                    warn "Masking $p->[OP]$p->[NAME]-$p->[VERSION]\n";
                    print "# Masked by $0\n";
                    $_ = "$p->[OP]$p->[NAME]-$p->[VERSION]\n";
                }
                last;
            }
        }
        print $_ unless /# (?:Masked|Unmasked) by $0/;
    }
}

sub append_leftover {
    my $pkgs = shift;
    open my $fh, ">>", $Real_Mask_Path
        or die "Could not open $Real_Mask_Path; Reason: $!";
    for (@$pkgs) {
        if (!$_->[MATCH] and !$_->[UNMASK]) {
            warn "Masking $_->[OP]$_->[NAME]-$_->[VERSION]\n";
            print $fh "# Masked by $0\n$_->[OP]$_->[NAME]-$_->[VERSION]\n";
        }
    }
    close $fh;
}

sub parse_package {
    my $pkg = shift;
    my ($version, $cmp);
    if ($pkg =~ s/^!?((?:[><]?=)|[><])//) {
        $cmp = $1;
    }
    else {
        $cmp = '>=';
    }
    if ($pkg =~ s/-(\d[-\w.*]*)$//) {
        $version = $1;
    }
    else {
        $version = 0;
    }
    return ($version, $cmp, $pkg);
}

sub get_local_packages {
    my $pkgs = [];
    open my $local_fh, "<", $Local_Mask_Path
        or die "Could not open $Local_Mask_Path; Reason: $!";
    while (<$local_fh>) {
        s/#.*//;
        s/\s+//g;
        next unless length;
        my ($version, $cmp, $name, $unmask);
        if (s/^!//) {
            $unmask = 1;
        }
        ($version, $cmp, $name) = parse_package($_);
        push @$pkgs, [$cmp, $version, $unmask, $name, 0];
    }
    close $local_fh;
    return $pkgs;
}

sub inrange {
    my ($base, $local, $cmp) = @_;

    my $ret = 0;
    if ($cmp == 0) {
        if (
            ($base eq '>' and $local eq '<') or
            ($base eq '<' and $local eq '>') or
            ($base eq '=' and $local !~ /=/)
        ) {
            $ret = 0;
        }
        else {
            $ret = 1;
        }
    }
    elsif ($cmp == 1) {
        if (
            (($base eq '>' or $base eq '>=') and ($local eq '<' or $local eq '<=' or $local eq '=')) or
            (($base eq '=' and ($local eq '<' or $local eq '<='))) 
        ) {
            $ret = 0;
        }
        else {
            $ret = 1;
        }
    }
    elsif ($cmp == -1) {
        if (
            (($base eq '<' or $base eq '<=') and ($local eq '>' or $local eq '>=')) or
            (($base eq '=' and ($local eq '>' or $local eq '>='))) 
        )
        {
            $ret = 0;
        }
        else {
            $ret = 1;
        }
    }
    else {
        die "Unknown cmp $cmp\n";
    }
    return $ret;
}

# Taken and modified from Sort::Versions
sub versioncmp ($$) {
    my @c = ($_[0] =~ /([-.]|\d+|[^-.\d]+)/g);
    my @d = ($_[1] =~ /([-.]|\d+|[^-.\d]+)/g);

    my ($star_left, $star_right, $ci, $di);
    for ($ci = 0, $di = 0; $ci < @c and $di < @d; $ci++, $di++) {
        my $c = $c[$ci];
        my $d = $d[$di];
        if ($c eq '-' and $d eq '-') {
            next;
        }
        elsif ( $c eq '-' ) {
            return -1;
        }
        elsif ( $d eq '-') {
            return 1;
        }
        elsif ($c eq '.' and $d eq '.') {
            next;
        }
        elsif ( $c eq '.' ) {
            return -1;
        }
        elsif ( $d eq '.' ) {
            return 1;
        }
        elsif ($c eq '*' or $d eq '*') {
            return 0;
        }
        elsif ($c =~ /^\d+$/ and $d =~ /^\d+$/) {
            if ($c =~ /^0/ || $d =~ /^0/) {
                return $c cmp $d if $c cmp $d;
            }
            else {
                return $c <=> $d if $c <=> $d;
            }
        }
        elsif ($c eq '*') {
            # Simple case
            if (($ci + 1) == @c) {
                return 0;
            }
        }
        else {
            $c = uc $c;
            $d = uc $d;
            return $c cmp $d if $c cmp $d;
        }       
    }
    @c <=> @d;
}