home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / share / binfmt-support / run-detectors
Encoding:
Text File  |  2006-06-19  |  3.5 KB  |  109 lines
  1. #! /usr/bin/perl -w
  2.  
  3. # Copyright (c) 2002 Colin Watson <cjwatson@debian.org>.
  4. #
  5. # This program is free software; you can redistribute it and/or modify
  6. # it under the terms of the GNU General Public License as published by
  7. # the Free Software Foundation; either version 2 of the License, or
  8. # (at your option) any later version.
  9. #
  10. # This program is distributed in the hope that it will be useful,
  11. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13. # GNU General Public License for more details.
  14. #
  15. # You should have received a copy of the GNU General Public License
  16. # along with this program; if not, write to the Free Software
  17. # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
  18.  
  19. use strict;
  20.  
  21. use Binfmt::Lib qw($admindir $procdir quit warning);
  22. use Binfmt::Format;
  23.  
  24. my @formats;
  25.  
  26. # Load in all our binary formats.
  27. local *ADMINDIR;
  28. unless (opendir ADMINDIR, $admindir) {
  29.     quit "unable to open $admindir: $!";
  30. }
  31. for my $name (readdir ADMINDIR) {
  32.     if (-f "$admindir/$name" and -e "$procdir/$name") {
  33.     my $format = Binfmt::Format->load ($name, "$admindir/$name");
  34.     $format->{magic} =~ s/\\x(..)/chr hex $1/eg;
  35.     $format->{mask}  =~ s/\\x(..)/chr hex $1/eg;
  36.     $format->{offset} ||= 0;
  37.     push @formats, $format if defined $format;
  38.     }
  39. }
  40. closedir ADMINDIR;
  41.  
  42. # Find out how much of the file we need to read. The kernel doesn't
  43. # currently let this be more than 128, so we shouldn't need to worry about
  44. # huge memory consumption.
  45. my $toread = 0;
  46. for my $format (@formats) {
  47.     if ($format->{type} eq 'magic') {
  48.     my $size = $format->{offset} + length $format->{magic};
  49.     $toread = $size if $size > $toread;
  50.     }
  51. }
  52.  
  53. my $buf = '';
  54. if ($toread) {
  55.     local *TARGET;
  56.     open TARGET, $ARGV[0] or quit "unable to open $ARGV[0]: $!";
  57.     read TARGET, $buf, $toread;
  58.     close TARGET;
  59. }
  60.  
  61. # Now the horrible bit. Since there isn't a real way to plug userspace
  62. # detectors into the kernel (which is why this program exists in the first
  63. # place), we have to redo the kernel's work. Luckily it's a fairly simple
  64. # job ... see linux/fs/binfmt_misc.c:check_file().
  65. #
  66. # There is a small race between the kernel performing this check and us
  67. # performing it. I don't believe that this is a big deal; certainly there
  68. # can be no privilege elevation involved unless somebody deliberately makes
  69. # a set-id binary a binfmt handler, in which case "don't do that, then".
  70.  
  71. my $extension;
  72. $ARGV[0] =~ /\.([^.]*)/ and $extension = $1;
  73.  
  74. my @ok_formats;
  75. for my $format (@formats) {
  76.     if ($format->{type} eq 'magic') {
  77.     my $segment = substr $buf, $format->{offset}, length $format->{magic};
  78.     $segment = "$segment" & "$format->{mask}" if length $format->{mask};
  79.     push @ok_formats, $format if $segment eq $format->{magic};
  80.     } else {
  81.     push @ok_formats, $format
  82.         if defined $extension and $extension eq $format->{magic};
  83.     }
  84. }
  85.  
  86. # Everything in @ok_formats is now a candidate. Loop through twice, once to
  87. # try everything with a detector and once to try everything without. As soon
  88. # as one succeeds, exec() it.
  89.  
  90. for my $format (@ok_formats) {
  91.     if (length $format->{detector}) {
  92.     my $status = system $format->{detector}, $ARGV[0];
  93.     $status /= 256;    # actual exit value
  94.     if ($status == 0) {
  95.         exec $format->{interpreter}, @ARGV
  96.         or warning "unable to exec $format->{interpreter} (@ARGV): $!";
  97.     }
  98.     }
  99. }
  100.  
  101. for my $format (@ok_formats) {
  102.     unless (length $format->{detector}) {
  103.     exec $format->{interpreter}, @ARGV
  104.         or warning "unable to exec $format->{interpreter} (@ARGV): $!";
  105.     }
  106. }
  107.  
  108. quit "unable to find an interpreter for $ARGV[0]";
  109.