Girocco/Util.pm

   1 package Girocco::Util;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Girocco::Config;
   7
   8 BEGIN {
   9         use base qw(Exporter);
  10         our @EXPORT = qw(scrypt jailed_file
  11                          lock_file unlock_file
  12                          filedb_atomic_append filedb_atomic_edit
  13                          valid_email valid_repo_url valid_web_url);
  14 }
  15
  16
  17 sub scrypt {
  18         my ($pwd) = @_;
  19         crypt($pwd, join ('', ('.', '/', 2..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64]));
  20 }
  21
  22 sub jailed_file {
  23         my ($filename) = @_;
  24         $Girocco::Config::chroot."/$filename";
  25 }
  26
  27 sub lock_file {
  28         my ($path) = @_;
  29
  30         $path .= '.lock';
  31
  32         use Errno qw(EEXIST);
  33         use Fcntl qw(O_WRONLY O_CREAT O_EXCL);
  34         use IO::Handle;
  35         my $handle = new IO::Handle;
  36
  37         unless (sysopen($handle, $path, O_WRONLY|O_CREAT|O_EXCL)) {
  38                 my $cnt = 0;
  39                 while (not sysopen($handle, $path, O_WRONLY|O_CREAT|O_EXCL)) {
  40                         ($! == EEXIST) or die "$path open failed: $!";
  41                         ($cnt++ < 16) or die "$path open failed: cannot open lockfile";
  42                         sleep(1);
  43                 }
  44         }
  45         # XXX: filedb-specific
  46         chmod 0664, $path or die "$path g+w failed: $!";
  47
  48         $handle;
  49 }
  50
  51 sub unlock_file {
  52         my ($path) = @_;
  53
  54         rename "$path.lock", $path or die "$path unlock failed: $!";
  55 }
  56
  57 sub filedb_atomic_append {
  58         my ($file, $line) = @_;
  59         my $id = 65536;
  60
  61         open my $src, $file or die "$file open for reading failed: $!";
  62         my $dst = lock_file($file);
  63
  64         while (<$src>) {
  65                 my $aid = (split /:/)[2];
  66                 $id = $aid + 1 if ($aid >= $id);
  67
  68                 print $dst $_ or die "$file(l) write failed: $!";
  69         }
  70
  71         $line =~ s/\\i/$id/g;
  72         print $dst "$line\n" or die "$file(l) write failed: $!";
  73
  74         close $dst or die "$file(l) close failed: $!";
  75         close $src;
  76
  77         unlock_file($file);
  78
  79         $id;
  80 }
  81
  82 sub filedb_atomic_edit {
  83         my ($file, $fn) = @_;
  84
  85         open my $src, $file or die "$file open for reading failed: $!";
  86         my $dst = lock_file($file);
  87
  88         while (<$src>) {
  89                 print $dst $fn->($_) or die "$file(l) write failed: $!";
  90         }
  91
  92         close $dst or die "$file(l) close failed: $!";
  93         close $src;
  94
  95         unlock_file($file);
  96 }
  97
  98 sub valid_email {
  99         $_ = $_[0];
 100         /^[a-zA-Z0-9+._-]+@[a-zA-Z0-9-.]+$/;
 101 }
 102 sub valid_web_url {
 103         $_ = $_[0];
 104         /^http:\/\/[a-zA-Z0-9-.]+(\/[_\%a-zA-Z0-9.\/~-]*)?(#[a-zA-Z0-9._-]+)?$/;
 105 }
 106 sub valid_repo_url {
 107         $_ = $_[0];
 108         /^http:\/\/[a-zA-Z0-9-.]+(\/[_\%a-zA-Z0-9.\/~-]*)?$/ or
 109          /^git:\/\/[a-zA-Z0-9-.]+(\/[_\%a-zA-Z0-9.\/~-]*)?$/;
 110 }
 111
 112
 113 1;