[fpc-pascal] file identification using libmagic

[Marc Santhoff]

Hi,

I have made a header port of libmagic which is used by the file(1)
command to identify the type of files. Usage examples are availble, too.

Since it could be of general interest, I'm posting it here. Test it,
stick it in LCCR or whatever.

Have fun,
Marc

-------------- next part --------------
unit libmagic;
interface
{ Made by Marc Santhoff in 2016
  Do anything you like with this code, no warranties of any kind given.
  Please respect other licenses, see below.

  Issues:
  - I had to change two of the MAGIC_XXXX constants because of name clashes.
    They got an additional underscore after the name, see below.
  - Uses unit unixtype, don't know how portable that is and which unit to use
    on Windows or elsewhere.
  - magic_set is declared as a pointer, could be some other type of handle
}
{
  Automatically converted by H2Pas 1.0.0 from /usr/include/magic.h
  The following command line parameters were used:
    -DC
    -l
    magic
    -o
    ./libmagic.pp
    /usr/include/magic.h
}

  uses unixtype; //ctypes;
  const
    External_library='magic'; {Setup as you need}

  Type
  Pchar  = ^char;
{$IFDEF FPC}
{$PACKRECORDS C}
{$ENDIF}


  {
   * Copyright (c) Christos Zoulas 2003.
   * All Rights Reserved.
   *
   * Redistribution and use in source and binary forms, with or without
   * modification, are permitted provided that the following conditions
   * are met:
   * 1. Redistributions of source code must retain the above copyright
   *    notice immediately at the beginning of the file, without modification,
   *    this list of conditions, and the following disclaimer.
   * 2. Redistributions in binary form must reproduce the above copyright
   *    notice, this list of conditions and the following disclaimer in the
   *    documentation and/or other materials provided with the distribution.
   *
   * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
   * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
   * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
   * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR
   * ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
   * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
   * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
   * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
   * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
   * SUCH DAMAGE.
    }

{ from /usr/src/contrib/file/src/files.h, imported here to be compact, ms }
{ how does C know the meaning of "magic_set"-type?, ms }

{ end from /usr/src/contrib/file/src/files.h }

{$ifndef _MAGIC_H}
{$define _MAGIC_H}  
{ $include <sys/types.h>}
  { No flags  }

  const
    MAGIC_NONE = $000000;    
  { Turn on debugging  }
    MAGIC_DEBUG = $000001;    
  { Follow symlinks  }
    MAGIC_SYMLINK = $000002;    
  { Check inside compressed files  }
    MAGIC_COMPRESS = $000004;    
  { Look at the contents of devices  }
    MAGIC_DEVICES = $000008;    
  { Return the MIME type  }
    MAGIC_MIME_TYPE = $000010;    
  { Return all matches  }
    MAGIC_CONTINUE = $000020;    
  { Print warnings to stderr  }
    MAGIC_CHECK_ = $000040;    // changed because of name conflict
  { Restore access time on exit  }
    MAGIC_PRESERVE_ATIME = $000080;    
  { Don't translate unprintable chars  }
    MAGIC_RAW = $000100;    
  { Handle ENOENT etc as real errors  }
    MAGIC_ERROR_ = $000200;    // changed because of name conflict
  { Return the MIME encoding  }
    MAGIC_MIME_ENCODING = $000400;    
    MAGIC_MIME = MAGIC_MIME_TYPE or MAGIC_MIME_ENCODING;    
  { Return the Apple creator and type  }
    MAGIC_APPLE = $000800;    
  { Don't check for compressed files  }
    MAGIC_NO_CHECK_COMPRESS = $001000;    
  { Don't check for tar files  }
    MAGIC_NO_CHECK_TAR = $002000;    
  { Don't check magic entries  }
    MAGIC_NO_CHECK_SOFT = $004000;    
  { Don't check application type  }
    MAGIC_NO_CHECK_APPTYPE = $008000;    
  { Don't check for elf details  }
    MAGIC_NO_CHECK_ELF = $010000;    
  { Don't check for text files  }
    MAGIC_NO_CHECK_TEXT = $020000;    
  { Don't check for cdf files  }
    MAGIC_NO_CHECK_CDF = $040000;    
  { Don't check tokens  }
    MAGIC_NO_CHECK_TOKENS = $100000;    
  { Don't check text encodings  }
    MAGIC_NO_CHECK_ENCODING = $200000;    
  { Defined for backwards compatibility (renamed)  }
    MAGIC_NO_CHECK_ASCII = MAGIC_NO_CHECK_TEXT;    
  { Defined for backwards compatibility; do nothing  }
  { Don't check ascii/fortran  }
    MAGIC_NO_CHECK_FORTRAN = $000000;    
  { Don't check ascii/troff  }
    MAGIC_NO_CHECK_TROFF = $000000;    
{ C++ extern C conditionnal removed }

type
  { improvising...
    the struct magic_set is declared in a private header, but is is used like
    a handle - ms
  }
  magic_set = pointer;

  magic_t = ^magic_set;

  function magic_open(_para1:longint):magic_t;cdecl;external External_library name 'magic_open';

  procedure magic_close(_para1:magic_t);cdecl;external External_library name 'magic_close';

  function magic_file(_para1:magic_t; _para2:Pchar):Pchar;cdecl;external External_library name 'magic_file';

  function magic_descriptor(_para1:magic_t; _para2:longint):Pchar;cdecl;external External_library name 'magic_descriptor';

  function magic_buffer(_para1:magic_t; _para2:pointer; _para3:size_t):Pchar;cdecl;external External_library name 'magic_buffer';

  function magic_error(_para1:magic_t):Pchar;cdecl;external External_library name 'magic_error';

  function magic_setflags(_para1:magic_t; _para2:longint):longint;cdecl;external External_library name 'magic_setflags';

  function magic_load(_para1:magic_t; _para2:Pchar):longint;cdecl;external External_library name 'magic_load';

  function magic_compile(_para1:magic_t; _para2:Pchar):longint;cdecl;external External_library name 'magic_compile';

  function magic_check(_para1:magic_t; _para2:Pchar):longint;cdecl;external External_library name 'magic_check';

  function magic_errno(_para1:magic_t):longint;cdecl;external External_library name 'magic_errno';

{$endif}
  { _MAGIC_H  }

implementation


end.
-------------- next part --------------
program libmagictest1;
{ Made by Marc Santhoff in 2016
  Do anything you like with this code, no warranties of any kind given.

  Tested on FreeBSD only, should work on other POSIXish OSs. There is a port
  of libmagic to windows, I didn't try.

  This code shows the usage of libmagic using a file name and path.
  usage:
    libmagictest1 <file1.abc> <file2.xyz> ...
}
{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes,
  { you can add units after this }
  sysutils, libmagic;

var
  mc: magic_t;
  i: integer;
  ftype: Pchar;
begin

  writeln('--- plain ---');
  mc := magic_open(MAGIC_NONE);

  if (mc = NIL) then begin
    writeln(stderr, inttostr(getlastoserror));
    halt(1);
  end;

  if (magic_load(mc, NIL) =-1) then begin
    writeln(stderr, magic_error(mc));
    magic_close(mc);
    halt(2);
  end;

  for i:=1 to paramcount do begin
    ftype := magic_file(mc, Pchar(paramstr(i)));
    write(paramstr(i) + ': '#09#09);
    if (ftype = NIL)
      then writeln(stderr, magic_error(mc))
      else writeln(stdout, ftype);
  end;

  magic_close(mc);

  writeln('--- MIME type ---');
  mc := magic_open(MAGIC_MIME);
  if (mc = NIL) then begin
    writeln(stderr, inttostr(getlastoserror));
    halt(1);
  end;
  if (magic_load(mc, NIL) =-1) then begin
    writeln(stderr, magic_error(mc));
    magic_close(mc);
    halt(2);
  end;
  for i:=1 to paramcount do begin
    ftype := magic_file(mc, Pchar(paramstr(i)));
    write(paramstr(i) + ': '#09#09);
    if (ftype = NIL)
      then writeln(stderr, magic_error(mc))
      else writeln(stdout, ftype);
  end;
  magic_close(mc);

end.

-------------- next part --------------
program libmagictest2;
{ Made by Marc Santhoff in 2016
  Do anything you like with this code, no warranties of any kind given.

  Tested on FreeBSD only, should work on other POSIXish OSs. There is a port
  of libmagic to windows, I didn't try.

  This code shows the usage of libmagic working on a memory buffer.
  usage:
    libmagictest2 <file1.abc> <file2.xyz> ...
}
{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes,
  { you can add units after this }
  sysutils, libmagic;

var
  mc: magic_t;
  i: integer;
  ftype: Pchar;
  mstream: TMemoryStream;
begin

    mc := magic_open(MAGIC_NONE);
    //mc := magic_open(MAGIC_MIME);

    if (mc = NIL) then begin
      writeln(stderr, inttostr(getlastoserror));
      halt(1);
    end;

    if (magic_load(mc, NIL) =-1) then begin
      writeln(stderr, magic_error(mc));
      magic_close(mc);
      halt(2);
    end;

    for i:=1 to paramcount do begin
      if (FileExists(paramstr(i))) then begin
        mstream := TMemoryStream.Create;
        mstream.LoadFromFile(paramstr(i));

        ftype := magic_buffer(mc, mstream.Memory, mstream.Size);

        write(paramstr(i) + ': '#09#09);
        if (ftype = NIL)
          then writeln(stderr, magic_error(mc))
          else writeln(stdout, ftype);

        FreeAndNil(mstream);
      end;
    end;

    magic_close(mc);

end.