#!/usr/bin/perl
#
# file -- report the type of a file
#
use FindBin;
use FileHandle;
use Getopt::Long;
use strict;
my $F = $FindBin::Script;
# translation of type in magic file to unpack template and byte count
my %TEMPLATES = (byte => [ 'c', 1 ],
ubyte => [ 'C', 1 ],
char => [ 'c', 1 ],
uchar => [ 'C', 1 ],
short => [ 's', 2 ],
ushort => [ 'S', 2 ],
long => [ 'l', 4 ],
ulong => [ 'L', 4 ],
date => [ 'l', 4 ],
ubeshort => [ 'n', 2 ],
beshort => [ [ 'n', 'S', 's' ], 2 ],
ubelong => [ 'N', 4 ],
belong => [ [ 'N', 'I', 'i' ], 4 ],
bedate => [ 'N', 4 ],
uleshort => [ 'v', 2 ],
leshort => [ [ 'v', 'S', 's' ], 2 ],
ulelong => [ 'V', 4 ],
lelong => [ [ 'V', 'I', 'i' ], 4 ],
ledate => [ 'V', 4 ],
string => undef);
# for letter escapes in magic file
my %ESC = ( n => "\n",
r => "\r",
b => "\b",
t => "\t",
f => "\f",
v => "\v" );
# from the BSD names.h, some tokens for hard-coded checks of
# different texts. This isn't rocket science. It's prone to
# failure so these checks are only a last resort.
my %SPECIALS = ("C program" => [ "/*",
"#include",
"char",
"double",
"extern",
"float",
"real",
"struct",
"union" ],
"C++ program" => [ "template",
"virtual",
"class",
"public:",
"private:" ],
"make commands" => [ "CFLAGS",
"LDFLAGS",
"all:",
".PRECIOUS" ],
"assembler program" => [ ".ascii",
".asciiz",
".byte",
".even",
".globl",
".text",
"clr" ],
"mail" => [ "Received:",
">From",
"Return-Path:",
"Cc:", ],
"news", => [ "Newsgroups:",
"Path:",
"Organization:" ] );
my $magicFile = $ENV{MAGIC}||$FindBin::Bin . "/../share/magic";
my $checkMagic;
my $followLinks;
my $fileList;
GetOptions("m=s",\$magicFile,
"c!", \$checkMagic,
"L!", \$followLinks,
"f=s",\$fileList);
# the names of the files are in $fileList.
if ($fileList) {
my $fileListFH = new FileHandle "< $fileList" or
die "$F: $fileList: $!\n";
unshift(@ARGV,<$fileListFH>);
$fileListFH->close();
}
if (!@ARGV && !$checkMagic) {
die "usage: $F [-cL] [-f filelist] [-m magicfile] file ...\n";
}
if ( ! -f $magicFile ) {
# have a fallback for now until a distribution heirarchy is done.
# this works on many unix systems.
if (! -f "/etc/magic" ) {
die "$F: Can't find magic file either in $magicFile or /etc/magic.\n";
}
$magicFile = "/etc/magic";
}
# a LoL from the magic file. We build this up as we go along
# and use what we've already buffered when looking at subsequent
# files.
my @magic;
print STDERR "Using magic file $magicFile\n" if $checkMagic;
# $MF is the magic file state: [ filehandle, buffered last line, line num ]
my $MF = [];
$$MF[0] = new FileHandle "< $magicFile" or die "$magicFile: $!\n";
$$MF[1] = undef;
$$MF[2] = 0;
readMagicEntry(\@magic,$MF);
# iterate over each file explicitly so we can seek
my $file;
foreach $file (@ARGV) {
# '-' is a problem because we can't seek on it.
# BSD's file just reads the first line. Sounds reasonable, but
# a hassle. Just complain.
if ($file eq '-') {
warn "Can't operate on standard input.\n";
next;
}
# the description line. append info to this string
my $desc = "$file:";
# 0) check permission
if (! -r $file) {
$desc .= " can't read `$file': Permission denied.";
print $desc,"\n";
next;
}
# 1) check for various special files first
if ($followLinks) { stat($file); } else { lstat($file); }
if (! -f _ or -z _) {
if ( !$followLinks && -l _ ) {
$desc .= " symbolic link to ".readlink($file);
}
elsif ( -d _ ) { $desc .= " directory"; }
elsif ( -p _ ) { $desc .= " named pipe"; }
elsif ( -S _ ) { $desc .= " socket"; }
elsif ( -b _ ) { $desc .= " block special file"; }
elsif ( -c _ ) { $desc .= " character special file"; }
elsif ( -z _ ) { $desc .= " empty"; }
else { $desc .= " special"; }
print $desc,"\n";
next;
}
# current file handle. or undef if checkMagic (-c option) is true.
my $fh;
$fh = new FileHandle "< $file" or die "$F: $file: $!\n" ;
# 2) check for script
if (-x $file && -T _) {
# Note, some magic files include elaborate attempts
# to match #! header lines and return pretty responses
# but this slows down matching and is unnecessary.
my $line1 = <$fh>;
if ($line1 =~ /^\#!\s*(\S+)/) {
$desc .= " executable $1 script text";
}
else { $desc .= " commands text"; }
print $desc,"\n";
$fh->close();
next;
}
# 3) iterate over each magic entry.
my $matchFound = 0;
my $m;
for ($m = 0; $m <= $#magic; $m++) {
# check if the m-th magic entry matches
# if it does, then $desc will contain an updated description
if (magicMatch($magic[$m],\$desc,$fh)) {
$matchFound = 1;
last;
}
# read another entry from the magic file if we've exhausted
# all the entries already buffered. readMagicEntry will
# add to the end of the array if there are more.
if ($m == $#magic && !$$MF[0]->eof()) {
readMagicEntry(\@magic,$MF);
}
}
# 4) check if it's text or binary.
# if it's text, then do a bunch of searching for special tokens
if (!$matchFound) {
if (-B $file) {
$desc .= " data";
}
else {
my $data;
$fh->seek(0,0);
$fh->read($data,8192); # this is how far BSD file looks
# in BSD's version, there's an effort to search from
# more specific to less, but I don't do that.
my ($type,$token);
foreach $type (keys %SPECIALS) {
foreach $token (@{$SPECIALS{$type}}) {
# we could do \b word boundaries if the end chars in
# $token were always \w, but they're not. this is
# crude guessing anyway.
if ($data =~ /\Q$token\E/m) {
$desc .= " $type";
goto ALLDONE;
}
}
}
ALLDONE:
$desc .= " text";
}
}
$fh->close();
print $desc,"\n";
}
if ($checkMagic) {
# read the whole file if we haven't already
while (!$$MF[0]->eof()) {
readMagicEntry(\@magic,$MF);
}
dumpMagic(\@magic);
}
exit 0;
####### SUBROUTINES ###########
# compare the magic item with the filehandle.
# if success, print info and return true. otherwise return undef.
#
# this is called recursively if an item has subitems.
sub magicMatch {
my ($item, $p_desc, $fh) = @_;
# delayed evaluation. if this is our first time considering
# this item, then parse out its structure. @$item is just the
# raw string, line number, and subtests until we need the real info.
# this saves time otherwise wasted parsing unused subtests.
$item = readMagicLine(@$item) if @$item == 3;
# $item could be undef if we ran into troubles while reading
# the entry.
return unless defined($item);
# $fh is not be defined if -c. that way we always return
# false for every item which allows reading/checking the entire
# magic file.
return unless defined($fh);
my ($offtype, $offset, $numbytes, $type, $mask, $op, $testval,
$template, $message, $subtests) = @$item;
# bytes from file
my $data;
# set to true if match
my $match = 0;
# offset = [ off1, sz, template, off2 ] for indirect offset
if ($offtype == 1) {
my ($off1, $sz, $template, $off2) = @$offset;
$fh->seek($off1,0) or return;
if ($fh->read($data,$sz) != $sz) { return };
$off2 += unpack($template,$data);
$fh->seek($off2,0) or return;
}
elsif ($offtype == 2) {
# relative offsets from previous seek
$fh->seek($offset,1) or return;
}
else {
# absolute offset
$fh->seek($offset,0) or return;
}
if ($type eq 'string') {
# read the length of the match string unless the
# comparison is '>' ($numbytes == 0), in which case
# read to the next null or "\n". (that's what BSD's file does)
if ($numbytes > 0) {
if ($fh->read($data,$numbytes) != $numbytes) { return; }
}
else {
my $ch = $fh->getc();
while (defined($ch) && $ch ne "\0" && $ch ne "\n") {
$data .= $ch;
$ch = $fh->getc();
}
}
# now do the comparison
if ($op eq '=') {
$match = ($data eq $testval);
}
elsif ($op eq '<') {
$match = ($data lt $testval);
}
elsif ($op eq '>') {
$match = ($data gt $testval);
}
# else bogus op, but don't die, just skip
if ($checkMagic) {
print STDERR "STRING: $data $op $testval => $match\n";
}
}
else {
#numeric
# read up to 4 bytes
if ($fh->read($data,$numbytes) != $numbytes) { return; }
# If template is a ref to an array of 3 letters,
# then this is an endian
# number which must be first unpacked into an unsigned and then
# coerced into a signed. Is there a better way?
if (ref($template)) {
$data = unpack($$template[2],
pack($$template[1],
unpack($$template[0],$data)));
}
else {
$data = unpack($template,$data);
}
# if mask
if (defined($mask)) {
$data &= $mask;
}
# Now do the check
if ($op eq '=') {
$match = ($data == $testval);
}
elsif ($op eq 'x') {
$match = 1;
}
elsif ($op eq '!') {
$match = ($data != $testval);
}
elsif ($op eq '&') {
$match = (($data & $testval) == $testval);
}
elsif ($op eq '^') {
$match = ((~$data & $testval) == $testval);
}
elsif ($op eq '<') {
$match = ($data < $testval);
}
elsif ($op eq '>') {
$match = ($data > $testval);
}
# else bogus entry that we're ignoring
if ($checkMagic) {
print STDERR "NUMERIC: $data $op $testval => $match\n";
}
}
if ($match) {
# it's pretty common to find "\b" in the message, but
# sprintf doesn't insert a backspace. if it's at the
# beginning (typical) then don't include separator space.
if ($message =~ s/^\\b//) {
$$p_desc .= sprintf($message,$data);
}
else {
$$p_desc .= ' ' . sprintf($message,$data) if $message;
}
my $subtest;
foreach $subtest (@$subtests) {
magicMatch($subtest,$p_desc,$fh);
}
return 1;
}
}
# readMagicEntry($pa_magic, $MF, $depth)
#
# reads the next entry from the magic file and stores it as
# a ref to an array at the end of @$pa_magic.
#
# $MF = [ filehandle, last buffered line, line count ]
#
# This is called recursively with increasing $depth to read in sub-clauses
#
# returns the depth of the current buffered line.
#
sub readMagicEntry {
my ($pa_magic, $MF, $depth) = @_;
# for some reason I need a local var because <$$MF[0]> doesn't work.(?)
my $magicFH = $$MF[0];
# a ref to an array containing a magic line's components
my $entry;
my $line = $$MF[1]; # buffered last line
while (1) {
if ($line =~ /^\#/ || $line =~ /^\s*$/) {
last if $magicFH->eof();
$line = <$magicFH>;
$$MF[2]++;
next;
}
my ($thisDepth) = ($line =~ /^(>+)/);
if (length($thisDepth) > $depth) {
$$MF[1] = $line;
# call ourselves recursively. will return the depth
# of the entry following the nested group.
if (readMagicEntry($entry->[2], $MF, $depth+1) < $depth ||
$$MF[0]->eof())
{
return;
}
$line = $$MF[1];
}
elsif (length($thisDepth) < $depth) {
$$MF[1] = $line;
return length($thisDepth);
}
elsif (defined(@$entry)) {
# already have an entry. this is not a continuation.
# save this line for the next call and exit.
$$MF[1] = $line;
return length($thisDepth);
}
else {
# we're here if the number of '>' is the same as the
# current depth and we haven't read a magic line yet.
# create temp entry
# later -- if we ever get around to evaluating this condition --
# we'll replace @$entry with the results from readMagicLine.
$entry = [ $line , $$MF[2], [] ];
# add to list
push(@$pa_magic,$entry);
# read the next line
last if $magicFH->eof();
$line = <$magicFH>;
$$MF[2]++;
}
}
}
# readMagicLine($line, $line_num, $subtests)
#
# parses the match info out of $line. Returns a reference to an array.
#
# Format is:
#
# [ offset, bytes, type, mask, operator, testval, template, sprintf, subtests ]
# 0 1 2 3 4 5 6 7 8
#
# subtests is an array like @$pa_magic.
#
sub readMagicLine {
my ($line, $line_num, $subtests) = @_;
my ($offtype, $offset, $numbytes, $type, $mask,
$operator, $testval, $template, $message);
# this would be easier if escaped whitespace wasn't allowed.
# grab the offset and type. offset can either be a decimal, oct,
# or hex offset or an indirect offset specified in parenthesis
# like (x[.[bsl]][+-][y]), or a relative offset specified by &.
# offtype : 0 = absolute, 1 = indirect, 2 = relative
if ($line =~ s/^>*([&\(]?[a-flsx\.\+\-\d]+\)?)\s+(\S+)\s+//) {
($offset,$type) = ($1,$2);
if ($offset =~ /^\(/) {
# indirect offset.
$offtype = 1;
# store as a reference [ offset1 type template offset2 ]
my ($o1,$type,$o2);
if (($o1,$type,$o2) = ($offset =~ /\((\d+)(\.[bsl])?([\+\-]?\d+)?\)/))
{
$o1 = oct($o1) if $o1 =~ /^0/o;
$o2 = oct($o2) if $o2 =~ /^0/o;
$type =~ s/\.//;
if ($type eq '') { $type = 'l'; } # default to long
$type =~ tr/b/c/; # type will be template for unpack
my $sz = $type; # number of bytes
$sz =~ tr/csl/124/;
$offset = [ $o1,$sz,$type,int($o2) ];
} else {
warn "$F: Bad indirect offset at line $line_num. '$offset'\n";
return;
}
}
elsif ($offset =~ /^&/o) {
# relative offset
$offtype = 2;
$offset = substr($offset,1);
$offset = oct($offset) if $offset =~ /^0/o;
}
else {
# normal absolute offset
$offtype = 0;
# convert if needed
$offset = oct($offset) if $offset =~ /^0/o;
}
}
else {
warn "$F: Bad Offset/Type at line $line_num. '$line'\n";
return;
}
# check for & operator on type
if ($type =~ s/&(.*)//) {
$mask = $1;
# convert if needed
$mask = oct($mask) if $mask =~ /^0/o;
}
# check if type is valid
if (!exists($TEMPLATES{$type})) {
warn "$F: Invalid type '$type' at line $line_num\n";
return;
}
# take everything after the first non-escaped space
if ($line =~ s/([^\\])\s+(.*)/$1/) {
$message = $2;
}
else {
warn "$F: Missing or invalid test condition or message at line $line_num\n";
return;
}
# remove the return if it's still there
$line =~ s/\n$//o;
# get the operator. if 'x', must be alone. default is '='.
if ($line =~ s/^([><&^=!])//o) {
$operator = $1;
}
elsif ($line eq 'x') {
$operator = 'x';
}
else { $operator = '='; }
if ($type eq 'string') {
$testval = $line;
# do octal/hex conversion
$testval =~ s/\\([x0-7][0-7]?[0-7]?)/chr(oct($1))/eg;
# do single char escapes
$testval =~ s/\\(.)/$ESC{$1}||$1/eg;
# put the number of bytes to read in numbytes.
# '0' means read to \0 or \n.
if ($operator =~ /[>x]/o) {
$numbytes = 0;
}
elsif ($operator =~ /[=<]/o) {
$numbytes = length($testval);
}
elsif ($operator eq '!') {
# annoying special case. ! operator only applies to numerics so
# put it back.
$testval = $operator . $testval;
$numbytes = length($testval);
$operator = '=';
}
else {
# there's a bug in my magic file where there's
# a line that says "0 string ^!<arc..." and the BSD
# file program treats the argument like a numeric. To minimize
# hassles, complain about bad ops only if -c is set.
warn "Invalid operator '$operator' for type 'string' at line $line_num.\n"
if $checkMagic;
return;
}
}
else {
# numeric
if ($operator ne 'x') {
# this conversion is very forgiving. it's faster and
# it doesn't complain about bugs in popular magic files,
# but it will silently turn a string into zero.
if ($line =~ /^0/o) {
$testval = oct($line);
} else {
$testval = int($line);
}
}
($template,$numbytes) = @{$TEMPLATES{$type}};
# unset coercion of $unsigned unless we're doing order comparison
if (ref($template)) {
$template = $$template[0]
unless $operator eq '>' || $operator eq '<';
}
}
return [ $offtype, $offset, $numbytes, $type, $mask,
$operator, $testval, $template, $message, $subtests ];
}
# recursively write the magic file to stderr. Numbers are written
# in decimal.
sub dumpMagic {
my ($magic,$depth) = @_;
my $entry;
foreach $entry (@$magic) {
# delayed evaluation.
$entry = readMagicLine(@$entry) if @$entry == 3;
next if !defined($entry);
my ($offtype, $offset, $numbytes, $type, $mask, $op, $testval,
$template, $message, $subtests) = @$entry;
print STDERR '>'x$depth;
if ($offtype == 1) {
$offset->[2] =~ tr/c/b/;
print STDERR "($offset->[0].$offset->[2]$offset->[3])";
}
elsif ($offtype == 2) {
print STDERR "&",$offset;
}
else {
# offtype == 0
print STDERR $offset;
}
print STDERR "\t",$type;
if ($mask) { print STDERR "&",$mask; }
print STDERR "\t",$op,$testval,"\t",$message,"\n";
if ($subtests) {
dumpMagic($subtests,$depth+1);
}
}
}
__END__
=pod
=head1 NAME
file - determine file type
=head1 SYNOPSIS
file [-c] [-f namefile] [-m magicfile] file ...
=head1 DESCRIPTION
The B<file> command tests each argument in an attempt to classify it.
There are four sets of tests, performed in this order: filesystem
tests, script tests, magic number tests, and language tests. The
first test that succeeds causes the file type to be printed.
The type printed will usually contain one of the words I<text> (the file
contains only printable ASCII characters), I<executable>, or I<data>
meaning anything else (usually 'binary' or non-printable).
The filesystem tests are based on examining the return from a I<stat>
system call. The program checks to see if the file is empty, or if
it's some sort of special file. Any known file types appropriate to
the system you are running on (sockets, symbolic links, or named
pipes (FIFOs) on those systems that implement them) are intuited.
The script tests are used when the file is an executable text file.
If the first line is a '#!' line, then the name of the program is
reported, otherwise the file is reported as 'commands text'.
The magic number tests are used to check for files with data in
particular fixed formats. Such files have a 'magic number' stored in
a particular place near the beginning of the file that indicates its
type. Any file with some invariant identifier at a small fixed offset
into the file can usually be described in this way.
Finally, if all of the previous tests fail and the file appears to be
an ASCII file, B<file> attempts to guess its language using a crude
search for common tokens associated with certain languages and file
types. These tests are less reliable than the previous two groups,
so they are performed last.
=head2 OPTIONS
B<file> accepts the following options:
=over 4
=item -m magicfile
Specify an alternate magic file containing magic numbers.
=item -c
Cause a debug checking printout of the parsed form of the magic file
and information regarding the magic file match process for any arguments.
This is usually used in conjunction with -B<m> to debug a new magic file
before installing it.
=item -f namefile
Read the names of the files to be examined from I<namefile> (one per line)
before the argument list.
=item -L
Follow symbolic links.
=back
=head1 FILES
The default magic file is I<../share/magic> located in the
distribution relative to the path of the program. If that is not
found, then an attempt is made to open I</etc/magic>, a common
location for a system magic file on many UNIX systems. Magic file
formats vary. This version supports the BSD format including
big-endian and little-endian numerics, ordered comparison of strings,
and use of numerics as dates. In particular, some file formats
interpret '<' or '>' as a literal character if matching a string, but
this implementation treats them as an operator.
Multiple levels of sub-tests are supported.
=head1 ENVIRONMENT
The environment variable I<MAGIC> can be used to override the default
location of the magic file. Command line options still take precedence.
=head1 BUGS
B<File> can't read from standard input.
This implementation is significantly slower than the C version. Much
of the time is startup, followed by the overhead of parsing the magic
file. Once the magic file is loaded after evaluating the first input
file, then subsequent evaluations are a little faster. I try to speed
the operation by only loading new entries from the magic file as I
need them and only parsing the subtests as needed, but this doesn't help
much.
Some simpler versions of magic (e.g. solaris') only allow the '='
operator for strings. Thus, the following line from the solaris
/etc/magic will be misinterpreted by this implementation of B<file>
(An '=' should be prepended):
0 string <ar> System V R1 archive
The BSD version of file has a few bugs which make it more tolerant
of bogus entries including:
>168 belong &=0x00000004 dynamically linked
0 string ^!<arch>\n_______64E Alpha archive
This implementation accepts bogus numerics without complaining, and
only complains about bogus operators if -B<c> is enabled.
Special identification of pre-POSIX tar files is not included.
Many magic files include elaborate attempts to match the starting line
of executable scripts. This implementation will not usually consider
these magic conditions because it identifies executable scripts
according to their '#!' line in a special test before considering
magic. This is faster and typically more reliable than attempts at
exact string matching on the first line of the script.
=head1 COPYRIGHT and LICENSE
This program is copyright by dkulp 1999.
This program is free and open software. You may use, copy, modify, distribute
and sell this program (and any modified variants) in any way you wish,
provided you do not restrict others to do the same, except for the following
consideration.
I read some of Ian F. Darwin's BSD C implementation, to
try to determine how some of this was done since the specification
is a little vague. I don't believe that this perl version could
be construed as an "altered version", but I did grab the tokens for
identifying the hard-coded file types in names.h and copied some of
the man page.
Here's his notice:
* Copyright (c) Ian F. Darwin, 1987.
* Written by Ian F. Darwin.
*
* This software is not subject to any license of the American Telephone
* and Telegraph Company or of the Regents of the University of California.
*
* Permission is granted to anyone to use this software for any purpose on
* any computer system, and to alter it and redistribute it freely, subject
* to the following restrictions:
*
* 1. The author is not responsible for the consequences of use of this
* software, no matter how awful, even if they arise from flaws in it.
*
* 2. The origin of this software must not be misrepresented, either by
* explicit claim or by omission. Since few users ever read sources,
* credits must appear in the documentation.
*
* 3. Altered versions must be plainly marked as such, and must not be
* misrepresented as being the original software. Since few users
* ever read sources, credits must appear in the documentation.
*
* 4. This notice may not be removed or altered.
=cut