package SafeFile;

# cpanel - SafeFile.pm                     Copyright(c) 2008 cPanel, Inc.
#                                                           All Rights Reserved.
# copyright@cpanel.net                                         http://cpanel.net
# This code is subject to the cPanel license. Unauthorized copying is prohibited

#be lean --
#use strict;
$SafeFile::VERSION = '1.5';

use Fcntl ();            # qw( O_WRONLY O_EXCL O_CREAT );
use cPScript::Logger ();
my $logger = cPScript::Logger->new();

my $verbose; # initialized in safelock

sub safeopen {
    my $fh = shift;
    my ( $mode, $file ) = _get_open_args(@_);

    if ( !$mode || !$file ) {
        $logger->warn('Invalid arguments');
        return;
    }

    if ( my $lockfile = safelock($file) ) {
        if ( open $fh, $mode, $file ) {
            {
                eval {
                    local $SIG{'ALRM'} = sub { die "flock 2 timeout"; };
                    my $orig_alarm = alarm 60;
                    flock $fh, 2;    # This will hang
                    alarm $orig_alarm;
                };
            }

            return $lockfile;
        }
        else {
            
            # Drop logging due to conflicts when used with Exim
            # if ( $mode eq '<' && !-e $file ) {
            #     $logger->info("no such file: $file") if $verbose;
            # }
            # else {
            #     $logger->warn("EUID [$>] could not open file $file for $mode: $!");
            # }
            safeunlock($lockfile);
            return;
        }
    }
    else {
        $logger->warn('could not get a lock');
        return;
    }
}

sub safeclose {
    my ( $fh, $lock ) = @_;

    if ( defined fileno $fh ) {
        {
            eval {
                local $SIG{'ALRM'} = sub { die "flock 8 timeout"; };
                my $orig_alarm = alarm 60;

                # "should" be silent if flock 2 didn't happen for whatever reason (timeout, not implemented, etc)
                flock $fh, 8;    # if flock 2 can hang so might this, might as well play it safe
                alarm $orig_alarm;
            };
        }
        close $fh;
    }

    return safeunlock($lock);
}

sub safe_replace_content {
    my ( $fh, @content ) = @_;
    @content = @{ $content[0] } if @_ == 2 && ref $content[0] eq 'ARRAY';
    seek( $fh, 0, 0 );
    print {$fh} @content;
    truncate( $fh, tell($fh) );
}

sub safelock {
    my $file = shift;
    if ( !$file ) {
        $logger->warn('safelock: Invalid arguments');
        return;
    }
    
    if ( !defined $verbose ) {
        $verbose = -e '/var/cpanel/safefile_verbose' ? 1 : 0;
    }

    local $0 = "$0 - waiting for lockfile";

    my $lockfile = _lock_wait($file);
    return if !$lockfile;

    # if something else gets a lock for $file right at this point this sysopen will fail
    if ( sysopen( my $lock_fh, $lockfile, &Fcntl::O_WRONLY | &Fcntl::O_EXCL | &Fcntl::O_CREAT, 0600 ) ) {

        # Setting "O_CREAT|O_EXCL" prevents the file from being opened if it is a symbolic link. It does not protect against symbolic links in the file's path.
        print $lock_fh $$ . "\n" . $0 . "\n";;    # syswrite $lock_fh, $$;
        close $lock_fh;
        return $lockfile;
    }
    else {

        # must've hit that race condition mentioend above, lets try again, this time lest make sure we can write files in the directory:
        my $lock_file_dir = _getdir($lockfile);

        # If we can't write to the directory, then we still want to flock and succeed
        if ( !-w $lock_file_dir ) {
            return 1;
        }

        my $second_lockfile = _lock_wait($file);
        return if !$second_lockfile;

        # if something else gets a lock for $file right at this point this sysopen will fail
        if ( sysopen( my $lock_fh, $second_lockfile, &Fcntl::O_WRONLY | &Fcntl::O_EXCL | &Fcntl::O_CREAT, 0600 ) ) {

            # Setting "O_CREAT|O_EXCL" prevents the file from being opened if it is a symbolic link. It does not protect against symbolic links in the file's path.
            print $lock_fh $$ . "\n";    # syswrite $lock_fh, $$;
            print $lock_fh $0 . "\n";
            close $lock_fh;
            return $second_lockfile;
        }
        else {
            $logger->warn('safelock: waited for lock twice');
            return;
        }
    }
}

sub safeunlock {
    my $lock = shift;

    if ( !$lock ) {
        $logger->warn('safeunlock: Invalid arguments');
        return;
    }
    elsif ( $lock eq '1' ) {

        # No lock file created so just succeed
        return 1;
    }

    if ( !-e $lock ) {
        $logger->warn("Lock $lock lost!");
        return;
    }

    my ( $lock_pid, $lock_name ) = _fetch_lockfile_info($lock);

    if ( !$lock_pid ) {
        
        # Sleep and reload to give process that wrote the like file time to flush it's changes to disk
        sleep 1;
        ( $lock_pid, $lock_name ) = _fetch_lockfile_info($lock);
        if ( !$lock_pid ) {
            unlink $lock;
# Should not be invalid because if a proc dies off via cpanel update it will always fail from this point on
            $logger->warn("Invalid zero length lock file $lock detected.");
            return;
        }
    }

    if ( $lock_pid == $$ ) {
        unlink $lock or return;
        return 1;
    }
    else {
# Should not be invalid because if a proc dies off via cpanel update it will always fail from this point on
        $logger->warn("[$$] Attempt to unlock file that was locked by another process [LOCK] $lock [LOCK PID] $lock_pid [LOCK PROCESS] $lock_name");
        return;
    }
}

sub _get_open_args {
    my ( $arg1, $arg2 ) = @_;
    my ( $mode, $file );
    if ( !$arg2 ) {
        ( $mode, $file ) = $arg1 =~ m/^([<>+|]+|)(.*)/;
        if ( $file && !$mode ) {
            $mode = '<';
        }
        elsif ( !$file ) {
            return;
        }
    }
    else {
        $file = $arg2;
        $mode = $arg1;
    }

    return if !$file;

    $mode =
        $mode eq '<'  ? '<'
      : $mode eq '>'  ? '>'
      : $mode eq '>>' ? '>>'
      : $mode eq '+<' ? '+<'
      : $mode eq '+>' ? '+>'
      :                 return;

    return ( $mode, $file );
}

sub _lock_wait {
    my $file     = shift;
    my $lockfile = $file . '.lock';
    $lockfile =~ s/^[><]*//g;

    # File is locked via SafeFile
    if ( -e $lockfile ) {
        my ( $fileuid, $locksize, $start_lockfile_mtime ) = ( stat(_) )[ 4, 7, 9 ];

        # Weird scenario where lockfile is empty. Log message for later debugging and die on non-public builds
        if ( !$locksize ) {
            # Sleep one second to make sure we are not just waiting for the lock file to be written to. 
            sleep (1);
            ( $fileuid, $locksize, $start_lockfile_mtime ) = ( stat($lockfile) )[ 4, 7, 9 ];

            if ( !defined $locksize) {
                #lock went away
                return $lockfile;
            } elsif ( $locksize == 0 ) {
                $logger->invalid("Invalid lockfile $lockfile detected (zero size) [UID]: $fileuid [MTIME]: $start_lockfile_mtime");
            }
        }
        
        # If the file doesn't exist, we still want a minumum of 60 seconds to
        # declare a lock file as old. The 0 value has a race condition where
        # the lock is created at the end of one second and we check at the
        # beginning of the next and delete a valid lock file.
        my $waittime = 60;
        if ( -e $file ) {
            $waittime = int( ( stat(_) )[7] / 10000 );
            $waittime = $waittime > 350 ? 350 : $waittime < 60 ? 60 : $waittime;    # waittime is always between 60 and 350 seconds
        }

        # Age of lock file in seconds
        my $lock_file_age = ( time() - $start_lockfile_mtime );

        # Lock file is older than waittime, just remove it
        if ( $lock_file_age > $waittime ) {
            $logger->info("Stale lock file: $lockfile. Age is $lock_file_age (mtime=$start_lockfile_mtime) which is longer then waittime ($waittime)") if $verbose;
            unlink $lockfile;
            return $lockfile;
        }

        my $lock_is_our_uid = ( $fileuid == $> );

        if ( $lock_is_our_uid || $> == 0 ) {
            my $proc_is_usable = _proc_is_usable();

            my $lock_pid = 0;
            my $lock_name;
            if ( $locksize && ( $lock_is_our_uid || $proc_is_usable ) ) {    # PID is inside lock file
                ( $lock_pid, $lock_name ) = _fetch_lockfile_info($lockfile);
            }

            if ( !$lock_pid ) {
                $logger->info("[$$] Waiting on invalid lock $lockfile for $waittime seconds") if $verbose;
            }
            elsif ( $lock_pid == $$ ) {
                $logger->invalid("[$$] Double locking detected on $file by self ($lock_name)");
                return;
            }
            else {
                $logger->info("[$$] Waiting for lock on $file held by $lock_name with pid $lock_pid") if $verbose;
            }

            if ( _is_valid_pid($lock_pid) && ( $lock_is_our_uid || ( $proc_is_usable && -e '/proc/' . $lock_pid ) ) ) {
                my $seconds_waiting = 0;
                while (1) {
                    sleep 1;
                    $seconds_waiting++;
                    last if ( $seconds_waiting > $waittime );
                    last if !-e $lockfile;
                    
                    # Only signal processes that have our same EUID
                    if ($lock_is_our_uid) {

                        # Stop waiting if PID is no longer active
                        if ( !kill( 0, $lock_pid ) ) {
                            last;
                        }
                    }
                    
                    # If PID exists in /proc, then wait for process to finish. Test above ensure we won't go past this point
                    elsif ( $proc_is_usable && !-e '/proc/' . $lock_pid ) {
                        last;
                    }
                }        

                # Wait for process finished, check the lockfile. If old one exists, unlink and return.
                # If new one exists, wait again.
                my $mtime = ( stat($lockfile) )[9];
                if ( !$mtime ) {
                    # process completed and removed lock.
                    $logger->info("[$$] Lock file $lockfile now gone, try to acquire") if $verbose;
                    return $lockfile;
                }
                if ( $mtime == $start_lockfile_mtime ) {
                    $logger->info("[$$] Removing expired lock file $lockfile") if $verbose;
                    unlink $lockfile;
                    return $lockfile;
                }
                else {
                    $start_lockfile_mtime = $mtime;
                }
            }
        }

        my $seconds_waiting = 0;
      WAIT:
        while ( $start_lockfile_mtime > 0 ) {
            if ( -e $lockfile ) {
                my $mtime = ( stat(_) )[9];
                sleep 1;
                if ( $mtime == $start_lockfile_mtime ) {
                    $seconds_waiting++;    # lock file has aged
                }
                else {                     # there is a new lock file, reset
                    $start_lockfile_mtime = $mtime;
                    $seconds_waiting      = 0;
                }
                if ( $seconds_waiting >= $waittime ) {    # lock file aged waittime sec and we can stop waiting
                    $logger->info("Lock file $lockfile expired") if $verbose;
                    unlink $lockfile;
                    last WAIT;
                }
            }
            else {
                
                # lock file doesn't exist, so no need to unlink it
                last WAIT;
            }
        }
    }
    return $lockfile;
}

sub safe_readwrite {
    my ( $file, $code_ref ) = @_;

    return if !defined $file || $file eq '' || ref $code_ref ne 'CODE';

    if ( my $lock = safeopen( \*SAFEEDIT, '+<', $file ) ) {

        my $rclog = $code_ref->( \*SAFEEDIT, \&safe_replace_content );

        safeclose( \*SAFEEDIT, $lock );

        # zero-but-true, perldoc SafeFile
        if ($rclog && $rclog ne '0E0') {
            require RcsRecord;
            RcsRecord::rcsrecord( $file, $rclog );
        }

        return $rclog;
    }
    else {
        return;
    }
}

sub _proc_is_usable {
    if ( -e '/proc/1' && -r _ ) {
        return 1;
    }
    return 0;
}

sub _fetch_lockfile_info {
    my $lockfile = shift;
    my ( $lock_pid, $lock_name );
    if ( open my $lockfile_fh, '<', $lockfile ) {
        my $pid_line = readline($lockfile_fh);
        $lock_name = ( readline($lockfile_fh) || 'unknown' );
        chomp($lock_name);
        if ( $pid_line =~ m/(\d+)/ ) {
            $lock_pid = $1;
        }
        close $lockfile_fh;
        return ( $lock_pid, $lock_name );
    }
}

sub _is_valid_pid {
    my $pid = shift;

    return ( $pid > 1 ? 1 : 0 );
}

sub _getdir {
    my $file = shift;
    my @path = split( /\/+/, $file );
    pop(@path);
    return join( '/', @path );
}

1;

__END__

=head1 All-In-One Safest

safe_readwrite( $path_to_file, $coderef );

where '$coderef' is:

sub {
    my ( $rw_fh, $safe_replace_content_coderef ) = @_;

    # do what you need with $rw_fh (+<)

    # return true with a string to make that the RcsRecord log entry
    return 'Changed foo to bar' if $safe_replace_content_coderef->( $rw_fh,  \@new_contents ); # or less efficiently ( $rw_fh, @new_content )
    return;

    # if you do not want to do the RcsRecord but still return true:
    #  return '0E0'; # there are other ways to say zero-but-true ('0e0', '0 but true') but we need to have a single way that works w/ string eq to aovid possible 'non numeric' warnings
}