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

« back to all changes in this revision

Viewing changes to mozilla/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;