scripts/errorlib.in

   1 # -*- perl -*-
   2
   3 sub F_SETLK { 6; } sub F_WRLCK{ 1; }
   4 $flockstruct= 'sslll'; # And there ought to be something for this too.
   5
   6 sub unlockreadbugmerge {
   7     local ($rv) = @_;
   8     &unfilelock if $rv >= 2;
   9     &unfilelock if $rv >= 1;
  10 }
  11
  12 sub lockreadbugmerge {
  13     local ($lref) = @_;
  14     if (!&lockreadbug($lref)) { return 0; }
  15     if (!length($s_mergedwith)) { return 1; }
  16     &unfilelock;
  17     &filelock('lock/merge');
  18     if (!&lockreadbug($lref)) { &unfilelock; return 0; }
  19     return 2;
  20 }
  21
  22 sub lockreadbug {
  23     local ($lref) = @_;
  24     &filelock("lock/$lref");
  25     if (!open(S,"db/$lref.status")) { &unfilelock; return 0; }
  26     chop($s_originator= <S>);
  27     chop($s_date= <S>);
  28     chop($s_subject= <S>);
  29     chop($s_msgid= <S>);
  30     chop($s_package= <S>);
  31     chop($s_keywords= <S>);
  32     chop($s_done= <S>);
  33     chop($s_forwarded= <S>);
  34     chop($s_mergedwith= <S>);
  35     chop($s_severity= <S>);
  36     close(S);
  37     return 1;
  38 }
  39
  40 sub filelock {
  41     # NB - NOT COMPATIBLE WITH `with-lock'
  42     local ($lockfile,$flockpushno,$evalstring,$count,$errors,@s1,@s2) = @_;
  43     $flockpushno= $#filelocks+1;
  44     $count= 10; $errors= '';
  45     for (;;) {
  46         $evalstring= "
  47             open(FLOCK${flockpushno},\"> \$lockfile\") || die \"open: \$!\";
  48             \$flockwant= pack(\$flockstruct,&F_WRLCK,0,0,1,0);".
  49                 ($] >= 5.000 ? "
  50             fcntl(FLOCK$flockpushno,&F_SETLK,\$flockwant) || die \"setlk: \$!\";" : "
  51             \$z= syscall(&SYS_fcntl,fileno(FLOCK$flockpushno),&F_SETLK,\$flockwant) < 0
  52                  && die \"syscall fcntl setlk: \$!\";") ."
  53             (\@s1= lstat(\$lockfile)) || die \"lstat: \$!\";
  54             (\@s2= stat(FLOCK$flockpushno)) || die \"fstat: \$!\";
  55             join(',',\@s1) eq join(',',\@s2) || die \"file switched\";
  56             1;
  57         ";
  58         last if eval $evalstring;
  59         $errors .= $@;
  60         eval "close(FLOCK$flockpushno);";
  61         if (--$count <=0) {
  62             $errors =~ s/\n+$//;
  63             &quit("failed to get lock on file $lockfile: $errors // $evalstring");
  64         }
  65         sleep 10;
  66     }
  67     push(@cleanups,'unfilelock');
  68     push(@filelocks,$lockfile);
  69 }
  70
  71 sub unfilelock {
  72     local ($lockfile) = pop(@filelocks);
  73     pop(@cleanups);
  74     eval 'close(FLOCK'.($#filelocks+1).');' || warn "failed to close lock file: $!";
  75     unlink($lockfile) || warn "failed to remove lock file: $!";
  76 }
  77
  78 sub quit {
  79     print DEBUG "quitting >$_[0]<\n";
  80     local ($u);
  81     while ($u= $cleanups[$#cleanups]) { &$u; }
  82     die "*** $_[0]\n";
  83 }
  84
  85 %saniarray= ('<','lt', '>','gt', '&','amp', '"','quot');
  86
  87 sub sani {
  88     local ($in) = @_;
  89     local ($out);
  90     while ($in =~ m/[<>&"]/) {
  91         $out.= $`. '&'. $saniarray{$&}. ';';
  92         $in=$';
  93     }
  94     $out.= $in;
  95     $out;
  96 }
  97
  98 @severities= @gSeverityList;
  99 @showseverities= @severities;
 100 grep ($_= $_ eq '' ? $gDefaultSeverity : $_, @showseverities);
 101 @strongseverities= @gStrongSeverities;
 102 %displayshowseverities= %gSeverityDisplay;
 103
 104 1;