[Savannah-cvs] administration/infra/bin sv_cvs_root_etc.pl

[Sylvain Beucler]

CVSROOT:        /cvsroot/administration
Module name:    administration
Branch:         
Changes by:     Sylvain Beucler <address@hidden>        05/03/15 22:47:51

Modified files:
        infra/bin      : sv_cvs_root_etc.pl 

Log message:
        Now handle concurrency with the frontend
        Some error handling
        Some cleanup
        Removed the trick where I checked only the first group's /etc/group 
timestamp: this would prevent a group created during sv_groups from being 
updated

CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/administration/administration/infra/bin/sv_cvs_root_etc.pl.diff?tr1=1.6&tr2=1.7&r1=text&r2=text

Patches:
Index: administration/infra/bin/sv_cvs_root_etc.pl
diff -u administration/infra/bin/sv_cvs_root_etc.pl:1.6 
administration/infra/bin/sv_cvs_root_etc.pl:1.7
--- administration/infra/bin/sv_cvs_root_etc.pl:1.6     Mon Mar 14 22:48:42 2005
+++ administration/infra/bin/sv_cvs_root_etc.pl Tue Mar 15 22:47:51 2005
@@ -22,17 +22,24 @@
 use strict;
 use Savannah;
 
-$ENV{'PATH'} = "/bin:/usr/bin";
-
-umask 0022; # first '0' is for Perl octal mode
+BEGIN {
+    my $lockfile = "/var/run/sv_database2system.lock";
+    $ENV{'PATH'} = "/bin:/usr/bin";
+
+    umask 0022; # first '0' is for Perl octal mode
+
+    # Locks: There are several sv_db2sys scripts but they should not run
+    #        concurrently.  So we add a lock
+    if (-e $lockfile) {
+       die "There's a lock ($lockfile), exiting";
+    }
+    `touch $lockfile`;
+}
 
-my $lockfile = "/var/run/sv_database2system.lock";
-# Locks: There are several sv_db2sys scripts but they should not run
-#        concurrently.  So we add a lock
-if (-e $lockfile) {
-    die "There's a lock ($lockfile), exiting";
+END {
+    my $lockfile = "/var/run/sv_database2system.lock";
+    unlink($lockfile);
 }
-`touch $lockfile`;
 
 
 my @projects = GetDB("groups, group_type",
@@ -43,18 +50,6 @@
 my $group_mtime = (stat("/etc/group"))[9];
 
 
-# - If the first group if already more recent that /etc/group, we can
-# stop the script directly. This does not handle the case where this
-# first group was manually edited since the last change in /etc/group,
-# but that should only occur rarely.
-
-my $repos_1st_group = "/savannah/cvsroot/$projects[0]/etc/group";
-my $repos_1st_group_mtime = (stat($repos_1st_group))[9];
-if ($repos_1st_group_mtime > $group_mtime) {
-    exit 0;
-}
-
-
 # Web groups for group types GNU, www.gnu.org and translation teams
 my @www_groups;
 # sv.gnu.org specific, related to the special group www 
@@ -91,25 +86,27 @@
     $passwd_content{$name} = $user_line;
 }
 
+
 my %group_content;
 my %group_passwd;
+
 # Builds the groups hash
 # Add www members to each webgroup
 # Fill in each group's shortened, specific passwd file.
-map {
-    my ($group_name, $x, $gid, $userlist) = split(':', $_);
+for my $group_line (@group_lines) {
+    my ($group_name, $x, $gid, $userlist) = split(':', $group_line);
     chomp $userlist;
     if (grep { $group_name eq $_ } @www_groups) {
        $userlist = ($userlist) ? "$userlist,$www_members" : $www_members;
-       $_ = join(":", $group_name, $x, $gid, $userlist) . "\n";
+       $group_line = join(":", $group_name, $x, $gid, $userlist) . "\n";
     }
-    $group_content{$group_name} = $_;
+    $group_content{$group_name} = $group_line;
 
     my @users = split(',', $userlist);
     foreach my $user (@users) {
        $group_passwd{$group_name} .= $passwd_content{$user};
     }
-} @group_lines;
+}
 
 # Debug
 # grep { print $_; } @group;
@@ -122,6 +119,8 @@
 # Process active public projects
 for my $project_name (sort @projects) {
     chomp($project_name);
+    # Skip projects not yet created (frontend/backend concurrency)
+    next if (!defined($group_content{$project_name}));
 
     my $repos_passwd = "/savannah/cvsroot/$project_name/etc/passwd";
     my $repos_passwd_mtime = (stat($repos_passwd))[9];
@@ -137,26 +136,32 @@
     }
 }
 
-unlink($lockfile);
 
 # Copies the content to the given file, only if the file does not
 # already contain the content (write access is more time consuming
 # than read access)
 sub copy() {
     my ($content, $file) = @_;
+    my $need_rewrite = 1;
+
+    if (open(IN, "< $file")) {
+       my $previous_content;
+       # slurp mode
+       my $backup = $/;
+       undef $/;
+       $previous_content = <IN>;
+       $/ = $backup;
+       close(IN);
+
+       if ($previous_content ne $content) {
+           $need_rewrite = 1;
+       }
+    }
 
-    open(IN, "< $file");
-    my $previous_content;
-    # slurp mode
-    my $backup = $/;
-    undef $/;
-    $previous_content = <IN>;
-    $/ = $backup;
-    close(IN);
-
-    if ($previous_content ne $content) {
-       open(OUT, "> $file");
-       print OUT $content;
-       close(OUT);
+    if (!open(OUT, "> $file")) {
+       warn "$0: Could not open $file: $!\n";
+       return;
     }
+    print OUT $content;
+    close(OUT);
 }