#!/usr/bin/perl -w

package Test::Repocop::ParentLock;

use strict;
use warnings;
use Fcntl;
use Proc::ProcessTable;
use Test::Repocop::Options;

use constant PERMITTED_NOT_LOCKED_NO_LOCK_FILE => 0;
use constant PERMITTED_NOT_LOCKED_INVALID_LOCK_FILE => 1;
use constant PERMITTED_NOT_LOCKED_STALE_LOCK_FILE => 2;
use constant PERMITTED_LOCKED_BY_US => 3;
use constant PERMITTED_LOCKED_BY_PARENT => 4;
use constant FORBIDDEN_LOCKED_BY_OTHERS => 5;
use constant FORBIDDEN_LOCKED_ACCESS_ERROR => 6;

my @msg;
$msg[PERMITTED_NOT_LOCKED_NO_LOCK_FILE] = 'No lock file';
$msg[PERMITTED_NOT_LOCKED_INVALID_LOCK_FILE] = 'Invalid lock file';
$msg[PERMITTED_NOT_LOCKED_STALE_LOCK_FILE] = 'Stale lock file (pid is dead)';
$msg[PERMITTED_LOCKED_BY_US] = 'Locked by given pid.';
$msg[PERMITTED_LOCKED_BY_PARENT] = 'Locked by the parent of the given pid';
$msg[FORBIDDEN_LOCKED_BY_OTHERS] = 'Locked by another group of processes';
$msg[FORBIDDEN_LOCKED_ACCESS_ERROR] = 'Access error. Assume locked.';

#------------------------------------------
my $lock=0;
&Test::Repocop::Options::get_common_options(
    "lock"  => sub {$lock=1},
    "unlock"  => sub {$lock=2},
);
my $parent_pid=$ARGV[0];

die "usage: $0 <PID>\n" unless $parent_pid;

#my $locker=Test::Repocop::ParentLock->new();
my $lockname = '.lock';

if ($lock==1) {
    exit 1 if !&lock("$repocop_cachedir/$lockname",$parent_pid);
    exit 0;
} elsif ($lock==2) {
    exit 1 if !&unlock("$repocop_cachedir/$lockname",$parent_pid);
    exit 0;
} else {
    my $status=&_lock_status("$repocop_cachedir/$lockname",$parent_pid);
    print "$status: ",$msg[$status],"\n";
    exit 0;
}
#--------------------------------------------

sub lock {
    my ($lockfile,$parent_pid) = @_;
    $parent_pid||=$$;
    my $SUCCESS=1;
    my $FAILURE=0;
    my $status=&_lock_status($lockfile,$parent_pid);

    if (
	$status==PERMITTED_LOCKED_BY_PARENT ||
	$status==PERMITTED_LOCKED_BY_US) {
	return $SUCCESS;
    } elsif (
	$status==PERMITTED_NOT_LOCKED_NO_LOCK_FILE ||
	$status==PERMITTED_NOT_LOCKED_INVALID_LOCK_FILE ||
	$status==PERMITTED_NOT_LOCKED_STALE_LOCK_FILE
	) {
	&_write_lock($lockfile, $parent_pid);
	return $SUCCESS;
    } elsif (
	$status==FORBIDDEN_LOCKED_ACCESS_ERROR ||
	$status==FORBIDDEN_LOCKED_BY_OTHERS
	) {
	return $FAILURE;
    } else {
	warn "internal error: _lock_status returned unsupported status $status";
	return $FAILURE;
    }
}

sub unlock {
    my ($lockfile,$parent_pid) = @_;
    $parent_pid||=$$;
    my $SUCCESS=1;
    my $FAILURE=0;
    my $status=&_lock_status($lockfile,$parent_pid);

    if (
	$status==PERMITTED_NOT_LOCKED_NO_LOCK_FILE or
	$status==PERMITTED_LOCKED_BY_PARENT
	) {
	return $SUCCESS;
    } elsif (
	$status==PERMITTED_LOCKED_BY_US or
	$status==PERMITTED_NOT_LOCKED_INVALID_LOCK_FILE or
	$status==PERMITTED_NOT_LOCKED_STALE_LOCK_FILE
	) {
	if (unlink $lockfile) {
	    return $SUCCESS;
	} else {
	    return $FAILURE;
	}
    } elsif (
	$status==FORBIDDEN_LOCKED_ACCESS_ERROR or
	$status==FORBIDDEN_LOCKED_BY_OTHERS
	) {
	return $FAILURE;
    } else {
	warn "internal error: _lock_status returned unsupported status $status";
	return $FAILURE;
    }
}


sub _lock_status {
    my $lockfile = shift;
    my $parent_pid = shift;
    $parent_pid||=$$;
    my %parentmap;
    my %pidmap;
    my $t = new Proc::ProcessTable( 'enable_ttys' => 0 );

    foreach my $p (@{$t->table}) {
	my $pid=$p->{'pid'};
	$parentmap{$pid}=$p->{'ppid'};
	$pidmap{$pid}=1;
    }

    return PERMITTED_NOT_LOCKED_NO_LOCK_FILE if (! -e $lockfile);

    if (!open(FH, '<', $lockfile)) {
	# lock file can't be opened.
	warn "can't open lock file $lockfile: $!\n";
	return FORBIDDEN_LOCKED_ACCESS_ERROR;
    } else {
	my $oldpid=<FH>;
	close (FH) or warn "can't close lock file $lockfile: $!";
	unless ($oldpid) {
	    warn "$lockfile does not have a pid";
	    return PERMITTED_NOT_LOCKED_INVALID_LOCK_FILE;
	}
	chomp $oldpid;
	if ($oldpid<=0) {
	    warn "$lockfile: invalid pid value $oldpid";
	    return PERMITTED_NOT_LOCKED_INVALID_LOCK_FILE;
	}

	return PERMITTED_LOCKED_BY_US if ($oldpid==$parent_pid);

	if ($pidmap{$oldpid}) {
	    # old pid still alive;
	    my $intermedpid=$parent_pid;
	    my $counter=0;
	    my $counter_threshhold=70000;
	    while ($intermedpid and $counter++ <$counter_threshhold) {
		if ($intermedpid==$oldpid) {
		    return PERMITTED_LOCKED_BY_PARENT;
		}
		$intermedpid=$parentmap{$intermedpid};
	    }
	    die "threshhold reached for $oldpid" if $counter >=$counter_threshhold;
	    # lock is valid but we are not born from parent
	    return FORBIDDEN_LOCKED_BY_OTHERS;
	}
	# lock file's pid is dead.
	return PERMITTED_NOT_LOCKED_STALE_LOCK_FILE;
    }
}

sub _write_lock {
    my ($lockfile, $parent_pid)=@_;
    # try to remove it if it exists.
    unlink $lockfile;

    sysopen(FH, $lockfile, O_WRONLY|O_CREAT|O_EXCL, 0644)
	or die "can't open lock file $lockfile: $!";
    syswrite(FH, "$parent_pid");
    close (FH) or die "can't close lock file $lockfile: $!";
}

__END__



=head1	NAME

repocop-cachedir-lock - locks repocop cache directory.

=head1	SYNOPSIS

B<repocop-cachedir-lock>
[B<-l|--lock> ]
[B<-u|--unlock> ]
[I<PID>]
[B<-h|--help>]
[B<-v|--verbose>]
[B<-q|--quiet>]
[B<-c|--cachedir> I<cachedir>]
[B<--et|--exclude-test> I<comma separated list of tests>]
[B<--it|--include-test> I<comma separated list of tests>]
[B<--ep|--exclude-packager> I<comma separated list of packager's nicks>]
[B<--ip|--include-packager> I<comma separated list of packager's nicks>]
[B<--pkgcollectors-dir> I<comma separated list of local collectors' dirs>]
[B<--srccollectors-dir> I<comma separated list of local collectors' dirs>]
[B<--pkgtests-dir> I<comma separated list of local tests' dirs>]
[B<--srctests-dir> I<comma separated list of local tests' dirs>]
[B<--ex|--except>] 
[B<-g|--given>] 
[B<-l|--last-run>] 
[B<--newer>] I<filename>
[B<-r|--report> <s[kip]|o[k]|w[arn]|f[ail]>]
[I<DIR>...] [I<FILE>...]

=head1	DESCRIPTION

B<repocop> executes a set of tests against each RPM package given on the
command line. Presize subset of tests can be selected using B<--include>
and B<--exclude> options.
Extra word splitting is performed on the I<comma separated list of tests>.
Each I<FILE> is treated as RPM package.  Each I<DIR> is listed with C<*.rpm>
pattern, and all RPM files found are processed.

=head1	OPTIONS

=over

=item	B<-l,--lock>

Lock

=item	B<-u,--unlock>

Unlock

=item	B<-c,--cachedir> I<dir>

Provides alternative location for cachedir. 
Repocop cachedir is a place where test results and 
packages metadata information are stored.

=item	B<--except>, B<--given>

Control processing of rpm arguments. 
B<--given> (default) means processing only given rpm arguments.
B<--except>  means processing all data except given rpm arguments.

=item	B<--et, --exclude-test> I<comma separated list of tests>

Report all processed tests exept the given excluded set.

=item	B<--it, --include-test> I<comma separated list of tests>

Report the given set of tests.

=item	B<--ep, --exclude-packager> I<comma separated list of tests>

=item	B<--it, --include-packager> I<comma separated list of tests>

Exclude/include packages according to Packager: tag.

=item [B<--pkgcollectors-dir> I<comma separated list of local collectors' dirs>]

=item [B<--srccollectors-dir> I<comma separated list of local collectors' dirs>]

=item [B<--pkgtests-dir> I<comma separated list of local tests' dirs>]

=item [B<--srctests-dir> I<comma separated list of local tests' dirs>]

Append user's local tests and collectors to repocop.

=item	B<-h, --help>

Display this help and exit.

=item	B<-v, --verbose>, B<-q, --quiet>

Verbosity level. Multiple -v increase the verbosity level, -q sets it to 0.

=item	B<-l, --last-run>

Use the set of packages processed at last run as an argument.

=item	B<--newer> I<filename>

Process packages newer then I<filename> only.
Note: this filtering does not apply to B<--last-run> option.

=item	B<--acl-file> I<file>

the argument is /path/to/Sisyphus/files/list/list.src.classic
This option is ALTLinux-specific. The file content is ACL db,
which is used to sort result by ALTLinux ACL.


=back

=head1	AUTHOR

Written by Igor Vlasenko <viy@altlinux.org>.

=head1	ACKNOWLEGEMENTS

To Alexey Torbin <at@altlinux.org>, whose qa-robot package
had a strong influence on repocop. 

=head1	COPYING

Copyright (c) 2008 Igor Vlasenko, ALT Linux Team.

This 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 of the License, or (at your option) any later version.

=cut
