~ubuntu-branches/ubuntu/quantal/enigmail/quantal-security

« back to all changes in this revision

Viewing changes to config/mozLock.pm

  • Committer: Package Import Robot
  • Author(s): Chris Coulson
  • Date: 2013-09-13 16:02:15 UTC
  • mfrom: (0.12.16)
  • Revision ID: package-import@ubuntu.com-20130913160215-u3g8nmwa0pdwagwc
Tags: 2:1.5.2-0ubuntu0.12.10.1
* New upstream release v1.5.2 for Thunderbird 24

* Build enigmail using a stripped down Thunderbird 17 build system, as it's
  now quite difficult to build the way we were doing previously, with the
  latest Firefox build system
* Add debian/patches/no_libxpcom.patch - Don't link against libxpcom, as it
  doesn't exist anymore (but exists in the build system)
* Add debian/patches/use_sdk.patch - Use the SDK version of xpt.py and
  friends
* Drop debian/patches/ipc-pipe_rename.diff (not needed anymore)
* Drop debian/patches/makefile_depth.diff (not needed anymore)

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
#
2
 
# This Source Code Form is subject to the terms of the Mozilla Public
3
 
# License, v. 2.0. If a copy of the MPL was not distributed with this
4
 
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
5
 
 
6
 
package mozLock;
7
 
 
8
 
use strict;
9
 
use IO::File;
10
 
use Cwd;
11
 
 
12
 
BEGIN {
13
 
    use Exporter ();
14
 
    use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
15
 
 
16
 
    $VERSION = 1.00;
17
 
    @ISA = qw(Exporter);
18
 
    @EXPORT = qw(&mozLock &mozUnlock);
19
 
    %EXPORT_TAGS = ( );
20
 
    @EXPORT_OK = qw();
21
 
}
22
 
 
23
 
my $lockcounter = 0;
24
 
my $locklimit = 100;
25
 
my $locksleep = 0.1;
26
 
my %lockhash;
27
 
 
28
 
# File::Spec->rel2abs appears to be broken in ActiveState Perl 5.22
29
 
# so roll our own
30
 
sub priv_abspath($) {
31
 
    my ($file) = @_;
32
 
    my ($dir, $out);
33
 
    my (@inlist, @outlist);
34
 
 
35
 
    # Force files to have unix paths.
36
 
    $file =~ s/\\/\//g;
37
 
 
38
 
    # Check if file is already absolute
39
 
    if ($file =~ m/^\// || substr($file, 1, 1) eq ':') {
40
 
        return $file;
41
 
    }
42
 
    $out = cwd . "/$file";
43
 
 
44
 
    # Do what File::Spec->canonpath should do
45
 
    @inlist = split(/\//, $out);
46
 
    foreach $dir (@inlist) {
47
 
        if ($dir eq '..') {
48
 
            pop @outlist;
49
 
        } else {
50
 
            push @outlist, $dir;
51
 
        }
52
 
    }
53
 
    $out = join '/',@outlist;
54
 
    return $out;
55
 
}
56
 
 
57
 
sub mozLock($) {
58
 
    my ($inlockfile) = @_;
59
 
    my ($lockhandle, $lockfile);
60
 
    $lockfile = priv_abspath($inlockfile);
61
 
    #print "LOCK: $lockfile\n";
62
 
    $lockcounter = 0;
63
 
    $lockhandle = new IO::File || die "Could not create filehandle for $lockfile: $!\n";    
64
 
    while ($lockcounter < $locklimit) {
65
 
        if (! -e $lockfile) {
66
 
            open($lockhandle, ">$lockfile") || die "$lockfile: $!\n";
67
 
            $lockhash{$lockfile} = $lockhandle;
68
 
            last;
69
 
        }
70
 
        $lockcounter++;
71
 
        select(undef,undef,undef, $locksleep);
72
 
    }
73
 
    if ($lockcounter >= $locklimit) {
74
 
        undef $lockhandle;
75
 
        die "$0: Could not get lockfile $lockfile.\nRemove $lockfile to clear up\n";
76
 
    }
77
 
}
78
 
 
79
 
sub mozUnlock($) {
80
 
    my ($inlockfile) = @_;
81
 
    my ($lockhandle, $lockfile);
82
 
    #$lockfile = File::Spec->rel2abs($inlockfile);
83
 
    $lockfile = priv_abspath($inlockfile);
84
 
    #print "UNLOCK: $lockfile\n";
85
 
    $lockhandle = $lockhash{$lockfile};
86
 
    if (defined($lockhandle)) {
87
 
        close($lockhandle);
88
 
        $lockhash{$lockfile} = undef;
89
 
        unlink($lockfile);
90
 
    } else {
91
 
        print "WARNING: $0: lockhandle for $lockfile not defined.  Lock may not be removed.\n";
92
 
    }
93
 
}
94
 
 
95
 
END {};
96
 
 
97
 
1;