package cPanel::CacheFile::FileLocker;

#use warnings;
use strict;
use Fcntl ();

our $VERSION = 0.400;

sub new {
    my ($class, $args_hr) = @_;
    $args_hr = {} unless defined $args_hr;
    die "Argument to new must be a hash reference.\n" unless 'HASH' eq ref $args_hr;
    die "Required logger argument is missing.\n" unless exists $args_hr->{logger};
    my %args = (
        attempts => 5,
        max_wait => 300, # five minutes
        max_age => 300, # five minutes
        flock_timeout => 60,
        sleep_secs => 1,
        %{$args_hr},
    );
    $args{sleep_secs} = 1 if $args{sleep_secs} < 1;

    return bless \%args, $class;    
}


sub file_lock {
    my ($self, $filename) = @_;
    my $attempts = $self->{attempts};
    my $lockfile = $filename . '.lock';
    $lockfile =~ tr/<>;&|//d;

    # wait up to the maximum time to hold a lock.
    my $deadline = time + $self->{max_wait};
    ATTEMPT:
    while( $attempts-- > 0 ) {
        # Try to create a lockfile
        if ( sysopen( my $fh, $lockfile, &Fcntl::O_WRONLY | &Fcntl::O_EXCL | &Fcntl::O_CREAT ) ) {
            # success
            my $ex = _flock_timeout( $fh, &Fcntl::LOCK_EX, $self->{flock_timeout} );
            if( $ex ) {
                close $fh;
                $self->_throw( "Timeout writing lockfile '$lockfile'." )
            }

            print $fh $$, "\n", $0, "\n", (time+$self->{max_wait}), "\n";

            close $fh;
            return $lockfile;
        }
        # Unable to create the lockfile.
        $self->_info( "Unable to create the lockfile, waiting" );

        while ( $deadline > time ) {
            my ($pid, $name, $max_time) = $self->_read_lock_file( $lockfile );
            unless ( $pid ) {
                # couldn't read the file. If it doesn't exist, try to create.
                next ATTEMPT unless -e $lockfile;
                sleep $self->{sleep_secs};
                next;
            }
            if ( time > $max_time ) {
                # The file says it is expired.
                my $expired = time - $max_time;
                $self->_info( "Stale lock file '$lockfile': lock expired $expired seconds ago, removing..." );
                unlink $lockfile;
                next ATTEMPT;
            }
            if ( $pid == $$ and $0 eq $name ) {
                $self->_throw( "Attempting to relock '$filename'." );
            }
            elsif ( $pid == $$ ) {
                # Was locked by another process with this PID or $0 changed.
                $self->_warn( "Inconsistent lock: my PID but process named '$name': removing lock" );
                unlink $lockfile;
                next ATTEMPT;
            }
            elsif ( !_pid_alive( $lockfile, $pid ) ) {
                if ( -e $lockfile ) {
                    $self->_warn( 'Removing abandoned lock file.' );
                    unlink $lockfile;
                }
                next ATTEMPT;
            }

            sleep $self->{sleep_secs};
        }
    }

    $self->_throw( "Failed to acquire lock for '$filename'." );
}


sub file_unlock {
    my ($self, $lockfile) = @_;

    $self->_throw( "Missing lockfile name." ) unless $lockfile;
    $lockfile =~ tr/<>;&|//d;
    unless ( -e $lockfile ) {
        $self->_warn( "Lockfile '$lockfile' lost!" );
        return;
    }
    my ($pid, $name, $wait_time) = $self->_read_lock_file( $lockfile );
    unless ( defined $pid ) {
        $self->_warn( "Lockfile '$lockfile' lost!" );
        return;
    }
    
    if ( 0 == $pid ) {
        $self->_warn( 'Zero-length lockfile deleted.' );
        return;
    }
    if ( $$ == $pid ) {
        unlink $lockfile;
        return;
    }
    else {
        $self->_throw( "Attempt to unlock file '$lockfile' locked by another process '$pid'." );
    }

}


sub _throw {
    my $self = shift;
    $self->{logger}->throw( @_ );
}

sub _warn {
    my $self = shift;
    return $self->{logger}->warn( @_ );
}

sub _info {
    my $self = shift;
    return $self->{logger}->info( @_ );
}

#
# Do flock call with a built in timeout.
#
# $fh - filehandle to flock
# $how - parameter for flock
# $when - timeout if it takes this many seconds.
#
# returns undef on success or "Timeout on flock\n" if it timed out.
sub _flock_timeout {
    my ($fh, $how, $when) = @_;
    my $orig_alarm;
    eval {
        local $SIG{'ALRM'} = sub { die "Timeout on flock\n"; };
        $orig_alarm = alarm $when;
        flock $fh, $how;
    };
    my $ex = $@;
    alarm $orig_alarm;
    return $ex
}

# Read information out of a lock file.
# Attempts multiple times, locks file while reading, deals with files that vanish, etc.
# Returns:
#   (pid, name) from file if successful.
#   undef  if lock file vanished
#   (0, 0) if zero-length file and we deleted it.
sub _read_lock_file {
    my ($self, $lockfile) = @_;

    my $attempts = $self->{attempts};
    while ( $attempts-- > 0 ) {
        if ( open( my $fh, '<', $lockfile ) ) {
            my $ex = _flock_timeout( $fh, &Fcntl::LOCK_SH, $self->{flock_timeout} );
            $self->_throw( "Timeout reading lockfile '$lockfile'." ) if $ex;

            # Provide defaults in case we did not have 3 lines.
            my ($pid, $name, $wait_time) = (<$fh>, '', '', '');

            close $fh;
            unless ( $pid ) { # retry, we got between open and lock (probably).
                sleep $self->{sleep_secs};
                next;
            }

            chomp($pid, $name, $wait_time);
            $self->_throw( "Invalid lock file: '$pid' is not a PID." ) if $pid =~ /\D/; 
            $name = '<unknown>' unless length $name;
            $wait_time = 0 if $wait_time =~ /\D/;
            return ($pid, $name, $wait_time);
        }
        return unless -e $lockfile; # file vanished, no longer locked.

        $self->_throw( "Cannot open lock file '$lockfile' for reading." ) unless -r _;
        sleep $self->{sleep_secs};
    }

    my $lock_age = time - (stat($lockfile))[9];
    # not the same as max_timeout, really looking at 5 minutes as old.
    if ( -z $lockfile ) {
        if ( $lock_age > $self->{max_age} ) {
            # the file has existed for some time but still has nothing in it.
            # kill it.
            $self->_info( 'Old, but empty lock file deleted.' );
            unlink $lockfile;
            return (0,0,0);
        }
        return;
    }

    $self->_throw( "Unable to read lockfile '$lockfile'" );
}

#
# Test the supplied lock and pid to see if the process is still alive.
#
#  $lockfile - file lock we are testing.
#  $pid - expected owner of the lockfile.
#
# Return false is the process no longer exists, true if the process exists
#    or is we can not tell.
sub _pid_alive {
    my ($lockfile, $pid) = @_;

    # if we can use kill to check the pid, it is best choice.
    my $fileuid = (stat($lockfile))[4];
    if ( $> == 0 || $> == $fileuid ) {
        return 0 unless kill( 0, $pid ) or $!{EPERM};
    }

    # If the proc filesystem is available, it's a good test.
    return -r "/proc/$pid" if -e "/proc/$$" && -r "/proc/$$";

    # Default to alive, because we can't figure it out.
    return 1;
}

1; # Magic true value required at end of module

__END__

Copyright (c) 2010, cPanel, Inc. All rights reserved.

This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic>.

