[Home]POPFile/Mutex

Amatubu_Wiki | POPFile | RecentChanges | Preferences

Mutex の改善

現在の POPFile::Mutex は、プロセス（スレッド）が異常終了してロックディレクトリが残ってしまった場合のことを想定していない。 このため、なんらかの原因でプロセス（スレッド）が（ロックを解除する前に）止まってしまった場合、ロックディレクトリが残ったままになり、他のプロセス（スレッド）に問題がない場合でもロックし続けた状態になってしまう。

これを改善するためには、現在のコードを見直す必要がある。

見直し案 1

mkdir ではなく、rename を使い、ロックが解除されないままになっている状態から復帰できるようにする。（参考：[1] 

package POPFile::Mutex;

#----------------------------------------------------------------------------
#
# This is a mutex object that uses rename() to provide exclusive access
# to a region on a per thread or per process basis.
#
# Copyright (c) 2001-2006 John Graham-Cumming
#
#   This file is part of POPFile
#
#   POPFile is free software; you can redistribute it and/or modify it
#   under the terms of version 2 of the GNU General Public License as
#   published by the Free Software Foundation.
#
#   POPFile is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with POPFile; if not, write to the Free Software
#   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
#----------------------------------------------------------------------------

use strict;

#----------------------------------------------------------------------------
# new
#
#   Create a new Mutex object (which may refer to a file referred to by
#   other mutexes) with a specific name generated from the name passed
#   in.
#
#----------------------------------------------------------------------------
sub new
{
    my ( $type, $name ) = @_;
    my $self;

    $self->{lock_folder__} = 'popfile_mutex';
    $self->{name__} = "${name}.mtx";
    $self->{path__} = $self->{lock_folder__} . '/' . $self->{name__};
#    release( $self );

    force_release( $self );

    return bless $self, $type;
}

#----------------------------------------------------------------------------
#
# acquire
#
#   Returns 1 if it manages to grab the mutex (and will block if necessary)
#   and 0 if it fails.
#
#----------------------------------------------------------------------------
sub acquire
{
    my ( $self,             # Reference to this object
         $trycount,         # Count to try
         $timeout ) = @_;   # Timeout in seconds to wait (undef = infinite)

    $trycount = 300 if ( !defined( $trycount ) );
    $timeout = 0xFFFFFFFF if ( !defined( $timeout ) );

    # Try to rename a file $trycount times
    for (my $i = 0; $i < $trycount; $i++, sleep 1) {
        if (rename($self->{path__}, $self->{current__} = $self->{path__} . time . '_' . $$)) {
            print "$$:RENAMED $self->{path__} to $self->{current__}\n";
            return $self->{current__};
        }
    }

    opendir(LOCKDIR, $self->{lock_folder__});
    my @filelist = readdir(LOCKDIR);
    closedir(LOCKDIR);
    foreach (@filelist) {
        if (/^$self->{name__}(\d+)/) {
            # If the lock file timed out, force unlock and lock
            if (time - $1 > $timeout and
                    rename($self->{lock_folder__} . $_, $self->{current__} = $self->{path__} . time . '_' . $$)) {
                print "$$:FORCE ";
                return $self->{current__};
            }
            last;
        }
    }
    undef;
}

#----------------------------------------------------------------------------
#
# release
#
#   Release the lock if we acquired it with a call to acquire()
#
#----------------------------------------------------------------------------
sub release
{
    my ( $self ) = @_;

    rename($self->{current__}, $self->{path__});
    $self->{locked__} = undef;
}


sub force_release
{
    my ( $self ) = @_;

    if (-f $self->{lock_folder__}) {
        mkdir( $self->{lock_folder__} );

    } else {
        opendir(LOCKDIR, $self->{lock_folder__});
        my @filelist = readdir(LOCKDIR);
        closedir(LOCKDIR);

        foreach (@filelist) {
            if (/^$self->{name__}(\d+)/) {
                unlink($self->{lock_folder__} . '/' . $_);
            }
        }
    }
    open(LOCKFILE, ">$self->{path__}");
    close(LOCKFILE);
}


1;

検証用コード。 

#!/usr/bin/perl

use strict;

use POPFile::Mutex;

my $mutex = new POPFile::Mutex('mailparse_kakasi');

for (0..10) {
    my $pid = fork();

    if ($pid) {
        # In parent process
    } else {
        # In child process
        mutex_test();
        last;
    }
}

sub mutex_test
{
    print "$$:GOING TO LOCK...\n";

    my $locked = $mutex->acquire(300,30);

    if (defined($locked)) {
        print "$$:LOCKED: lockfile=$locked\n";
    } else {
        print "$$:COULD NOT LOCK\n";
        return;
    }

    print "$$:DOING JOB...\n";
    sleep(10);
    print "$$:FINISHED JOB\n";

    print "$$:GOING TO UNLOCK...\n";

    $mutex->release();

    print "$$:UNLOCKED\n";
}

うまい方法のように思えるが、なぜか LOCK 状態なのにさらに LOCK されてしまうという問題が。ログには 

-2344:GOING TO LOCK...
-2700:GOING TO LOCK...
-2372:GOING TO LOCK...
-2372:LOCKED popfile_mutex/mailparse_kakasi.mtx1197448264_-2372
-2372:LOCKED: lockfile=popfile_mutex/mailparse_kakasi.mtx1197448264_-2372
-2372:DOING JOB...
-3804:GOING TO LOCK...
-3284:GOING TO LOCK...
-2424:GOING TO LOCK...
-3768:GOING TO LOCK...
-2532:GOING TO LOCK...
-2636:GOING TO LOCK...
-3456:GOING TO LOCK...
-3628:GOING TO LOCK...
-2372:FINISHED JOB
-2372:GOING TO UNLOCK...
-2372:UNLOCKED
-3804:LOCKED popfile_mutex/mailparse_kakasi.mtx1197448274_-3804
-3804:LOCKED: lockfile=popfile_mutex/mailparse_kakasi.mtx1197448274_-3804
-3804:DOING JOB...
-3804:FINISHED JOB
-3804:GOING TO UNLOCK...
-3804:UNLOCKED
-3284:LOCKED popfile_mutex/mailparse_kakasi.mtx1197448284_-3284
-3284:LOCKED: lockfile=popfile_mutex/mailparse_kakasi.mtx1197448284_-3284
-3284:DOING JOB...
-3284:FINISHED JOB
-3284:GOING TO UNLOCK...
-3284:UNLOCKED
-3768:LOCKED popfile_mutex/mailparse_kakasi.mtx1197448294_-3768
-3768:LOCKED: lockfile=popfile_mutex/mailparse_kakasi.mtx1197448294_-3768
-3768:DOING JOB...
-3768:FINISHED JOB
-3768:GOING TO UNLOCK...
-3768:UNLOCKED
-2424:LOCKED popfile_mutex/mailparse_kakasi.mtx1197448304_-2424
-2424:LOCKED: lockfile=popfile_mutex/mailparse_kakasi.mtx1197448304_-2424
-2424:DOING JOB...
-2424:FINISHED JOB
-2424:GOING TO UNLOCK...
-2424:UNLOCKED
-2532:LOCKED popfile_mutex/mailparse_kakasi.mtx1197448314_-2532
-2532:LOCKED: lockfile=popfile_mutex/mailparse_kakasi.mtx1197448314_-2532
-2532:DOING JOB...
-2532:FINISHED JOB
-2532:GOING TO UNLOCK...
-2532:UNLOCKED
-3456:LOCKED popfile_mutex/mailparse_kakasi.mtx1197448324_-3456
-3456:LOCKED: lockfile=popfile_mutex/mailparse_kakasi.mtx1197448324_-3456
-3456:DOING JOB...
-3456:FINISHED JOB
-3456:GOING TO UNLOCK...
-3456:UNLOCKED
-2636:LOCKED popfile_mutex/mailparse_kakasi.mtx1197448334_-2636
-2636:LOCKED: lockfile=popfile_mutex/mailparse_kakasi.mtx1197448334_-2636
-2636:DOING JOB...
-2636:FINISHED JOB
-2636:GOING TO UNLOCK...
-2636:UNLOCKED
-3628:LOCKED popfile_mutex/mailparse_kakasi.mtx1197448344_-3628
-3628:LOCKED: lockfile=popfile_mutex/mailparse_kakasi.mtx1197448344_-3628
-3628:DOING JOB...
-3628:FINISHED JOB
-3628:GOING TO UNLOCK...
-3628:UNLOCKED
-2700:LOCKED popfile_mutex/mailparse_kakasi.mtx1197448355_-2700
-2700:LOCKED: lockfile=popfile_mutex/mailparse_kakasi.mtx1197448355_-2700
-2700:DOING JOB...
-2344:LOCKED popfile_mutex/mailparse_kakasi.mtx1197448355_-2344
-2344:LOCKED: lockfile=popfile_mutex/mailparse_kakasi.mtx1197448355_-2344
-2344:DOING JOB...
-2700:FINISHED JOB
-2700:GOING TO UNLOCK...
-2700:UNLOCKED
-2344:FINISHED JOB
-2344:GOING TO UNLOCK...
-2344:UNLOCKED
というような表示。ほぼうまくいっているが、プロセス -2700 と -2344 の処理が排他になっていない（Windows、ActivePerl 5.8.8 build 822 で検証）。

元のコードについて、 

sub my_flock {
  my %lfh = (dir => './lockdir/', basename => 'lockfile',
	     timeout => 60, trytime => 10, @_);
  $lfh{path} = $lfh{dir} . $lfh{basename};

  for (my $i = 0; $i < $lfh{trytime}; $i++, sleep 1) {
    return \%lfh if (rename($lfh{path}, $lfh{current} = $lfh{path} . time));
  }
  opendir(LOCKDIR, $lfh{dir});
  my @filelist = readdir(LOCKDIR);
  closedir(LOCKDIR);
  foreach (@filelist) {
    if (/^$lfh{basename}(\d+)/) {
      return \%lfh if (time - $1 > $lfh{timeout} and
	  rename($lfh{dir} . $_, $lfh{current} = $lfh{path} . time));
      last;
    }
  }
  undef;
}

sub my_funlock {
  rename($_[0]->{current}, $_[0]->{path});
}

for (0..10) {

    my $pid = fork();

    if ($pid) {
    } else {
		# ロックする(タイムアウトあり)
		$lfh = my_flock(trytime=>100) or die 'Busy!';
		
		print "$$:LOCKED. lockfile=$lfh->{current}\n";
		sleep(10);

		# アンロックする
		my_funlock($lfh);
		print "$$:UNLOCKED.\n";
        last;
    }

}
という形でテストしてみたところ、これも同じ結果。複数のロックが一度に行われてしまう。

rename はだめなのか？　もしくは何か勘違いしているのか･･･？

見直し案 2

mkdir を使ったまま、ロックフォルダが古くなっていれば強制解除。 

package POPFile::Mutex3;

#----------------------------------------------------------------------------
#
# This is a mutex object that uses mkdir() to provide exclusive access
# to a region on a per thread or per process basis.
#
# Copyright (c) 2001-2006 John Graham-Cumming
#
#   This file is part of POPFile
#
#   POPFile is free software; you can redistribute it and/or modify it
#   under the terms of version 2 of the GNU General Public License as
#   published by the Free Software Foundation.
#
#   POPFile is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with POPFile; if not, write to the Free Software
#   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
#----------------------------------------------------------------------------

use strict;

#----------------------------------------------------------------------------
# new
#
#   Create a new Mutex object (which may refer to a file referred to by
#   other mutexes) with a specific name generated from the name passed
#   in.
#
#----------------------------------------------------------------------------
sub new
{
    my ( $type, $name ) = @_;
    my $self;

    $self->{name__} = "popfile_mutex_${name}.mtx";
    release( $self );

    return bless $self, $type;
}

#----------------------------------------------------------------------------
#
# acquire
#
#   Returns 1 if it manages to grab the mutex (and will block if necessary)
#   and 0 if it fails.
#
#----------------------------------------------------------------------------
sub acquire
{
    my ( $self,             # Reference to this object
         $trycount,         # Count to try (undef = infinite)
         $timeout ) = @_;   # Timeout in seconds to force unlock
                            # (undef = infinite)

    # If acquire() has been called without a matching release() then
    # fail at once

    if ( defined( $self->{locked__} ) ) {
        return 0;
    }

    # Wait a very long time if no timeout is specified

    $trycount = 0x7FFFF if ( !defined( $trycount ) );
    $timeout  = 0xFFFFFFFF if ( !defined( $timeout  ) );

    # Try to create a directory during the timeout period

    for (0..$trycount) {
        if ( mkdir( $self->{name__}, 0755 ) ) { # Create a directory
            $self->{locked__} = 1;
            return 1;
        }
        select( undef, undef, undef, 0.5 );

        # If the lock directory is old enough, force unlock

        my $t = (stat $self->{name__})[9];
        if ( mkdir( $self->{name__} . '_r', 0755 ) ) {
            if ( time - $t > $timeout ) {
                release( $self );
            }
            rmdir( $self->{name__} . '_r' );
        }
    }

    # Timed out so return 0
    return 0;
}

#----------------------------------------------------------------------------
#
# release
#
#   Release the lock if we acquired it with a call to acquire()
#
#----------------------------------------------------------------------------
sub release
{
    my ( $self ) = @_;

    rmdir( $self->{name__} ); # Delete the Mutex directory
    $self->{locked__} = undef;
}

1;

これも解除している間にアクセスされたら……という問題はあるが、ロック解除できなくなってしまう現状よりはましかな。

Amatubu_Wiki | POPFile | RecentChanges | Preferences
This page is read-only | View other revisions
Last edited December 12, 2007 23:47 by Amatubu (diff)
Search:

Copyright (c) 1996-2019 naoki iimura e-mail