Developers of Sympa

[Kazuo Moriwaka <address@concealed>]

Hello, 

I post NFS-aware locking patch.  Please check attachment.

I changed locking module to File::NFSLock. It has shared lock.

I'm sorry for I cannot find "include" directive what you wrote.
I implement module existence check temporarily with 'eval'.   If there
are some problems, please correct it.

regards,
-- 
Kazuo Moriwaka <address@concealed>

--- ../sympa-5.0.1/src/Conf.pm  2005-06-06 18:56:06.000000000 +0900
+++ src/Conf.pm 2005-07-01 13:16:00.000000000 +0900
@@ -57,7 +57,7 @@
                       ldap_export_name ldap_export_host ldap_export_suffix 
ldap_export_password
                       ldap_export_dnmanager ldap_export_connection_timeout 
urlize_min_size
                       list_check_smtp list_check_suffixes  spam_protection 
web_archive_spam_protection soap_url
-                      web_recode_to
+                      web_recode_to lock_method nfs_lock_timeout
 );
 
 my %old_options = ('trusted_ca_options' => 'capath,cafile',
@@ -186,6 +186,8 @@
      'supported_lang' => 'fr,en_US,hu,it,ja_JP,de',
      'web_recode_to' => '',
      'default_remind_task' => '',
+     'lock_method' => 'flock',
+     'nfs_lock_timeout' => 3600,
      );
    
 my $wwsconf;
--- ../sympa-5.0.1/src/tools.pl 2005-05-04 21:39:32.000000000 +0900
+++ src/tools.pl        2005-07-01 13:16:00.000000000 +0900
@@ -1986,6 +1974,71 @@
     return 1;
 }
 
+if (($Conf{'lock_method'} eq 'nfs') and (eval "require File::NFSLock")) {
+    use File::NFSLock;
+    use Fcntl qw(LOCK_EX LOCK_NB);
+
+    %locks = ();
+
+    # lock on NFS
+    sub lock {
+       my $lock_file = shift;
+       my $mode = shift; ## read or write
+
+       my $hold = $Conf{'nfs_lock_timeout'};
+       
+       if ($mode eq 'read') {
+           $operation = LOCK_SH;
+       }else {
+           $operation = LOCK_EX;
+           $open_mode = '>>';
+       }
+       
+       ## Read access to prevent "Bad file number" error on Solaris
+       unless (open FH, $open_mode.$lock_file) {
+           &do_log('err', 'Cannot open %s: %s', $lock_file, $!);
+           return undef;
+       }
+       
+       my $got_lock = 1;
+        my $lock = undef;
+       
+       if ($lock = new File::NFSLock {
+           file      => $lock_file,
+           lock_type => $operation|LOCK_NB,
+           blocking_timeout   => $hold,
+           stale_lock_timeout => $hold,
+       }) {
+           &do_log('debug2', 'Got lock for %s on %s', $mode, $lock_file);
+           $locks{$lock_file} = $lock;
+       }else {
+           &do_log('err', 'Failed locking %s: %s', $lock_file, $!);
+           close(FH);
+           return undef;
+       }
+       
+       return \*FH;
+    }
+    
+    # unlock on NFS
+    sub unlock {
+       my $lock_file = shift;
+       my $fh = shift;
+       
+       my $lock = $locks{$lock_file};
+       delete $locks{$lock_file};
+       
+       unless ($lock->unlock) {
+           &do_log('err', 'Failed UNlocking %s: %s', $lock_file, $!);
+           return undef;
+       }
+       close $fh;
+       
+       &do_log('debug2', 'Release lock on %s', $lock_file);
+       
+       return 1;
+    }
+}
 
 sub move_message {
 # move a message to distribute spool
--- ../sympa-5.0.1/check_perl_modules.pl        2005-01-26 23:50:29.000000000 
+0900
+++ check_perl_modules.pl       2005-07-01 13:15:56.000000000 +0900
@@ -45,7 +45,8 @@
             'Bundle::LWP' => '1.09',
             'SOAP::Lite' => '0.60',
             'MHonArc::UTF8' => '2.4.6',
-            'MIME::Base64' => '3.03'
+            'MIME::Base64' => '3.03',
+            'File::NFSLock' => '1.20',
             );
 
 ### key:left "module" used by SYMPA, 
@@ -80,7 +81,8 @@
             'IO::Socket::SSL' => 'IO-Socket-SSL',
             'Net::SSLeay' => 'NET-SSLeay',
             'Bundle::LWP' => 'LWP',
-            'SOAP::Lite' => 'SOAP-Lite');
+            'SOAP::Lite' => 'SOAP-Lite',
+            'File::NFSLock' => 'File-NFSLock');
 
 %opt_features = ('DBI' => 'a generic Database Driver, required by Sympa to 
access Subscriber information and User preferences. An additional Database 
Driver is required for each database type you wish to connect to.',
                 'DBD::mysql' => 'Mysql database driver, required if you 
connect to a Mysql database.\nYou first need to install the Mysql server and 
have it started before installing the Perl DBD module.',
@@ -96,7 +98,9 @@
                 'IO::Socket::SSL' => 'required by CAS (single sign-on) and 
the \'include_remote_sympa_list\' feature that includes members of a list on 
a remote server, using X509 authentication',
                 'Net::SSLeay' => 'required by the 
\'include_remote_sympa_list\' feature that includes members of a list on a 
remote server, using X509 authentication',
                 'Bundle::LWP' => 'required by the 
\'include_remote_sympa_list\' feature that includes members of a list on a 
remote server, using X509 authentication',
-                'SOAP::Lite' => 'required if you want to run the Sympa SOAP 
server that provides ML services via a "web service"');
+                'SOAP::Lite' => 'required if you want to run the Sympa SOAP 
server that provides ML services via a "web service"',
+                'File::NFSLock' => 'required if you want to lock over NFS',
+                );
 
 ### main:
 print "******* Check perl for SYMPA ********\n";