Finding all open filehandles and closing them before exiting

Discussion in 'Perl Misc' started by Vilmos Soti, Apr 21, 2004.

  1. Vilmos Soti

    Vilmos Soti Guest

    Hello,

    I am trying to find all open filehandles in my program and close
    them before exiting.

    Among many things, my program mounts a disk (runs under Linux),
    finds all files with File::Find, then copies the files with
    File::Copy. I use filenames as parameters to copy in order to
    keep my program simple, and also because the manpage for File::Copy
    recommends using filenames wherever possible.

    I have a signal handler which tries to unmount the disk in
    the case of a sigint, but it will fail if copy from File::Copy
    has an open filehandle on the mounted disk.

    Here is a short program which fully illustrates my problem:
    (I excluded the checking of return values for the sake of keeping
    this short program, well, short)

    #################### program starts ####################

    #!/usr/bin/perl -w

    use strict;
    use File::Copy;

    sub bye () {
    print "in function bye\n";
    system ("umount /tmp/mountpoint");
    exit;
    }

    $SIG{INT} = \&bye;

    system ("mount -o loop /tmp/filesystem.img /tmp/mountpoint");
    system ("ls -l /tmp/mountpoint");
    print "copy starts\n";
    copy ("/tmp/mountpoint/devzero", "/tmp/mountpoint/devnull");

    #################### program ends ####################

    And here are the results after running the program:

    #################### results start ####################

    [[email protected] pts/6 tmp]# ./a.pl
    total 12
    crw-rw-rw- 1 root root 1, 3 Dec 31 1969 devnull
    crw-rw-rw- 1 root root 1, 5 Dec 31 1969 devzero
    drwxr-xr-x 2 root root 12288 Apr 21 11:19 lost+found
    copy starts
    in function bye
    umount: /tmp/mountpoint: device is busy
    [[email protected] pts/6 tmp]#

    #################### results end ####################

    Is there any way to find all open files and close them?
    Or a way to close all open files apart from stdin, stdout, and stderr?

    I (possibly naively) tried to iterate through %main:: and find
    all filehandles, descend into additional structures if I need to,
    but I didn't succeed. I just tried and tried and tried, and
    failed and failed and failed.

    Here is the code snipplet I had in the "bye" function.

    #################### Code starts ####################

    foreach my $key (sort keys %main::) {
    my $x = \$main::{$key};
    print $x;
    print "\n";
    }

    #################### Code ends ####################

    However, it returned only GLOBs. I am out of ideas.

    Of course, I could write my own copy function, but I would
    prefer to use the already existing functions, and also to
    keep my code small and simple.

    Also, I could close the FROM and TO filehandles in bye,
    but that, besides being an ugly hack is an understatement,
    is not a general solution, and has no learning value.

    I hope I provided enough information about my misery and
    my efforts of how I tried to solve it.

    Thanks, Vilmos
     
    Vilmos Soti, Apr 21, 2004
    #1
    1. Advertisements

  2. ]
    [ ... ]
    [ ... ]

    Try running the script from another directory - other than /tmp.

    Usually, when you get the message you have gotten, it's because you're
    in the mount you're trying to unmount.

    I'm not saying this is the problem, but it is worth looking at. I've done
    something similar with an NFS mount and found that if I was in the mount,
    I'd get a message stating the resource was busy.

    HTH

    --
    Jim

    Copyright notice: all code written by the author in this post is
    released under the GPL. http://www.gnu.org/licenses/gpl.txt
    for more information.

    a fortune quote ...
    What you don't know can hurt you, only you won't know it.
     
    James Willmore, Apr 22, 2004
    #2
    1. Advertisements

  3. Vilmos Soti

    Anno Siegel Guest

    I can see a few possible solutions. Searching stashes for filehandles
    is probably the last thing I'd try :)

    For one, the signal handler could just set a flag instead of unmounting.
    The main loop would check that flag after each copy and umount/exit
    if it is set. That way no filehandles from File::Copy are open when
    the unmount occurs.

    Another possibility (under Unix) is to run "exec umount" instead
    of "system umount". Since normal files are closed on exec, that
    should do it too.

    Finally, you could bite the bullet and use filehandles with File::Copy
    and keep track of them. I don't think there are any disadvantages
    under Unix.

    Anno
     
    Anno Siegel, Apr 22, 2004
    #3
  4. Vilmos Soti

    Vilmos Soti Guest

    Thanks for your help. I also feel this is not the most elegant/best
    solution, but this is what I managed to come up with. :)
    Yes, this is one possibility. But it will need a hefty rewrite
    on my part. Here is a code snipplet (written from head, not the
    actual code) how I handle the exiting from the program.

    #################### Code snipplet starts ####################

    sub bye ($) {
    print "$_[0]\n";
    if ($bye{dbconnect}) {
    $bye{dbconnect} = 0;
    $dbh->disconnect ();
    }
    if ($bye{mount}) {
    $bye{mount} = 0;
    system ("umount ...");
    }
    ...
    exit
    }

    $SIG{INT} = \&bye;

    $dbh = DBI->connect ... or bye ("DBI connect failed: $!");
    $bye{dbconnect} = 1;
    ....
    system ("mount ...") or bye ("mounting failed: $!");
    $bye{mount} = 1;

    #################### Code snipplet ends ####################

    So in this case, the %bye hash keeps track what needs to be
    cleaned up at exit, and in the course of the program if
    anything goes wrong, &bye will do the right thing.

    I can rewrite the whole exiting procedure, but I just hope that
    I can stuck the solution into &bye. :)
    Hmmm, I didn't think of that. Thanks for the idea. However, this
    is not the best solution. This program basically reads a removable
    disk, and is going to be used by people who are not really
    computer experts, and I wouldn't even call them knowledgable users.
    So I want to handle everything in my program. If at the end I
    exec umount, then it will be already outside the program, and if
    it fails, I cannot handle it. And they will be confused if the
    cd/mod doesn't eject. However, this might be the least bad solution.
    My main problem with this route is that it will complicate
    my code. Not that this few lines would cause me a headache,
    but I would prefer to keep my code as simple as possible
    and easy to maintain by others. Starting to reimplement
    parts of the core module is not the route I really want to
    do. This is what I did before, or at least before I started
    to read this newsgroup... I learned. :)

    I think I will stick with the exec umount solution. I can live
    with the unlikely event that the program is interrupted by
    hand and it doesn't exit truly gracefully at the price of
    keeping my code small and simple. Thanks for the idea.

    Vilmos
     
    Vilmos Soti, Apr 22, 2004
    #4
  5. Vilmos Soti

    Anno Siegel Guest

    Quite apart from the unmount problem, this looks like something that
    should go into an END block.
    [snip some discussion]
    You don't have to exec a bare umount, you can exec another Perl
    process (which may be the same script, called with some special
    parameter), to do the umount and all the handling involved. You
    still have your original stdout and stdin to interact with the user,
    but all normal files are closed. None of this is tested, obviously...

    Anno
     
    Anno Siegel, Apr 22, 2004
    #5
  6. ]
    [ ... ]

    Try running the script from another directory - other than /tmp.

    Usually, when you get the message you have gotten, it's because you're
    in the mount you're trying to unmount.

    I'm not saying this is the problem, but it is worth looking at. I've done
    something similar with an NFS mount and found that if I was in the mount,
    I'd get a message stating the resource was busy.

    HTH

    --
    Jim

    Copyright notice: all code written by the author in this post is
    released under the GPL. http://www.gnu.org/licenses/gpl.txt
    for more information.

    a fortune quote ...
    What you don't know can hurt you, only you won't know it.
     
    James Willmore, Apr 26, 2004
    #6
  7. Vilmos Soti

    Vilmos Soti Guest

    That's not the problem. In the original program (which I didn't
    include since it is big and the relevant parts are spread over),
    I actually switch to "/" before unmounting. This program I included
    here was an example program which described the problem.

    Vilmos
     
    Vilmos Soti, Apr 26, 2004
    #7
  8. Try this: (worked on my system Fedora Core 1)

    #!/usr/bin/perl
    use strict;
    use warnings;
    use File::Copy;

    $SIG{INT} = sub{ die "signal: ".$_[0]; };

    system ("mount -o loop /tmp/filesystem.img /tmp/mountpoint");
    system ("ls -l /tmp/mountpoint");
    print "copy starts\n";
    eval {
    copy ("/tmp/mountpoint/devzero", "/tmp/mountpoint/devnull");
    };
    if ([email protected]) {
    warn [email protected], "\n";
    }
    system ("umount /tmp/mountpoint");



     
    Bryan Castillo, Apr 29, 2004
    #8
  9. Vilmos Soti

    Vilmos Soti Guest

    Thanks for the idea, but it didn't work for me. Our system
    is RedHat 7.3 with perl 5.6.0. I know this is a bit old,
    but for some reasons (which has nothing to do with technical
    or internal bureaucratic issues) it is not so easy to upgrade.

    Vilmos
     
    Vilmos Soti, Apr 30, 2004
    #9
  10. What didn't work? The device was still busy? Or there was something
    wrong with the script? Do you have the output?
     
    Bryan Castillo, May 1, 2004
    #10
  11. Vilmos Soti

    Vilmos Soti Guest

    The device was busy. I added an extra line to the program (not
    at hand now) before the 'system ("umount ...")' command which was
    nothing more than a 'system ("ls -l /proc/$$/fd/")' to see
    if the file was still open. Indeed, it was still open.

    On Monday I can post the actual output. The box is not available
    now.

    Thanks for your help, Vilmos
     
    Vilmos Soti, May 1, 2004
    #11
  12. Vilmos Soti

    Rocco Caputo Guest

    I use this:

    use POSIX qw(MAX_OPEN_FDS);
    POSIX::close($_) for $^F+1 .. MAX_OPEN_FDS;

    It's a heavy-handed way to close every file descriptor, whether open or
    not. It won't close stdin, stdout, or stderr, however. For that, use 0
    instead of $^F+1.
     
    Rocco Caputo, May 1, 2004
    #12
  13. Are you sure MAX_OPEN_FDS is right?

    [email protected]:/usr/include>/usr/local/bin/perl -e "use POSIX
    qw(MAX_OPEN_FDS)"
    "MAX_OPEN_FDS" is not exported by the POSIX module at
    /usr/local/lib/perl5/5.6.1/sun4-solaris/POSIX.pm line 19
    Can't continue after import errors at
    /usr/local/lib/perl5/5.6.1/sun4-solaris/POSIX.pm line 19
    BEGIN failed--compilation aborted at -e line 1.

    I found this in limits.h

    #define OPEN_MAX 64 /* max # of files a process can have
    open */

    Is this what you meant?

    [email protected]:/usr/include>perl -MPOSIX -e 'print POSIX::OPEN_MAX(),
    "\n"'
    64

    Not really a perl question then, but if you do use this logic, are you
    assured that the OS will reuse file descriptor numbers? So there is a
    max of 64 open files on this particular system, but does that mean
    that all file descriptor numbers will be < OPEN_MAX? (I guess I
    should really ask on comp.unix.programmer or better yet read the
    Single Unix Specification).
     
    Bryan Castillo, May 3, 2004
    #13
  14. Vilmos Soti

    Vilmos Soti Guest

    The mountpoint was still busy.

    Here is a small program I ran.

    ############################## Program starts ##############################

    #!/usr/bin/perl -w

    use strict;
    use File::Copy;

    sub bye () {
    print "############## ls starts ############\n";
    system ("ls -l /proc/$$/fd");
    print "############## ls ends ############\n\n";

    print "############## lsof starts ############\n";
    system ("/usr/sbin/lsof /tmp/mp");
    print "############## lsof ends ############\n\n";

    system ("/bin/umount /tmp/mp");
    exit;
    }

    $SIG{INT} = \&bye;

    print "copy starts\n";
    eval {
    copy ("/tmp/mp/devzero", "/tmp/mp/devnull");
    }

    ############################## Program ends ##############################

    And here is the result:

    ############################## Running starts ##############################

    [[email protected] pts/0 tmp]# ./a.pl
    copy starts
    in bye
    ############## ls starts ############
    total 0
    lrwx------ 1 root root 64 May 3 20:50 0 -> /dev/pts/0
    lrwx------ 1 root root 64 May 3 20:50 1 -> /dev/pts/0
    lrwx------ 1 root root 64 May 3 20:50 2 -> /dev/pts/0
    lr-x------ 1 root root 64 May 3 20:50 3 -> /tmp/mp/devzero
    l-wx------ 1 root root 64 May 3 20:50 4 -> /tmp/mp/devnull
    lr-x------ 1 root root 64 May 3 20:50 5 -> pipe:[68433]
    ############## ls ends ############

    ############## lsof starts ############
    COMMAND PID USER FD TYPE DEVICE SIZE NODE NAME
    a.pl 6663 root 3r CHR 1,5 12 /tmp/mp/devzero
    a.pl 6663 root 4w CHR 1,3 13 /tmp/mp/devnull
    ############## lsof ends ############

    umount: /tmp/mp: device is busy
    [[email protected] pts/0 tmp]#

    ############################## Running ends ##############################

    This is a bit different (newer) system. RedHat 8.0 and perl v5.8.0.

    I tried Rocco's MAX_OPEN_FDS solution (which is still unavailable
    on my nntp server), but I had the same problem you had: POSIX didn't
    know about it.

    Thanks for your help,

    Vilmos

    # echo "Just Another Perl Lacker,"
     
    Vilmos Soti, May 4, 2004
    #14
  15. Vilmos Soti

    Anno Siegel Guest

    Under POSIX the name of the limit is _POSIX_OPEN_MAX, not MAX_OPEN_FDS.

    Anno
     
    Anno Siegel, May 4, 2004
    #15
  16. Vilmos Soti

    Rocco Caputo Guest

    I'm sorry. I had some code above it to set MAX_OPEN_FDS based on
    _SC_OPEN_MAX. It would take a wild guess if _SC_OPEN_MAX wasn't
    defined.

    # Determine the most file descriptors we can use.
    my $max_open_fds;
    eval {
    $max_open_fds = sysconf(_SC_OPEN_MAX);
    };
    $max_open_fds = 1024 unless $max_open_fds;
    eval "sub MAX_OPEN_FDS () { $max_open_fds }";
    die if [email protected];

    It should probably check OPEN_MAX as well, just to be safe.

    I'm pretty sure most (if not all) operating systems with the concept of
    file descriptor numbers will reuse them. I've witnessed several of them
    first-hand, including DOS, various forms of Windows, AIX, and OS/2. The
    UNIX variants do it as a matter of course.

    Descriptor numbers are used for things like select() bit vector indices,
    so they can't increase forever. That might not stop someone from
    writing a kernel that does it, but we can kneecap them and leave them by
    the door as a reminder to the others. :)

    -- Rocco Caputo - http://poe.perl.org/
     
    Rocco Caputo, May 5, 2004
    #16
  17. Vilmos Soti

    P Buder Guest

    Closing everything up to POSIX_OPEN_MAX will not necessarily close all files. It is
    defined as a quantity you are guaranteed to have available to you, but the system may
    support more. Also, keep in mind the number of FILE pointers you can have via the
    perl open /C fopen can be less than the number of file descriptors via perl
    sysopen/C open. In one version of Solaris you could have 256 FILE pointers but
    1024 file descriptors as I recall.
     
    P Buder, May 8, 2004
    #17
  18. Vilmos Soti

    Rocco Caputo Guest

    I'm skeptical about this, but I'll let it stand because I don't have
    evidence to the contrary.
    I disagree. Multiple streams (FILE* in C) can refer to the same file
    descriptor. Check out the documentation for fdopen(3), which will
    create a new stream associated with an existing open descriptor.

    I can illustrate it in Perl. Here both the WHEE and STDIN file handles
    share descriptor 0.

    1) poerbook:~% perl -wle 'open(WHEE, "<&=STDIN"); print fileno(STDIN); \
    print fileno(WHEE)'
    0
    0

    Closing the descriptor with POSIX::close() will close all the handles
    associated with it. It's "sneaky" enough that Perl won't give you the
    "print() on closed filehandle" warning.

    1) poerbook:~% perl -wle 'use POSIX; open(WHEE, ">&=STDOUT"); \
    POSIX::close(fileno(WHEE)); print "narf"'
    1) poerbook:~%

    -- Rocco Caputo - http://poe.perl.org/
     
    Rocco Caputo, May 9, 2004
    #18
    1. Advertisements

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments (here). After that, you can post your question and our members will help you out.