Hi Martin,
Hopefully you can help me here. I have install perl and ran all the install modules ok.
Then add the keys into registry using c:\mailbox\in and c:\mailbox\out.
I have created the 2 directories above.
When I run the script (saved in c:\mailbox) it comes up with directory not found: inqueue="c:\mailbox\in"
couldn’t create directory: inqueue="c:\mailbox\in" - invalid argument at tnefdecode.pl line 533.
I have double checked and the directories in the registry definitely match the actual directories.
I have deleted the in and out directory thinking the script would make them but still the same error.
Permissions for read/write are fully open on the directory.
Any help will be greatly appreciated.

Hi nezzal,

Sorry for the delay - I'm just back from a short holiday.

[HKEY_LOCAL_MACHINE\SOFTWARE\Fastraq\Mailtraq\MessageFilters\TnefDecode]
"OutQueue"="C:\\mailbox\\out"
"InQueue"="C:\\mailbox\\in"

If that doesn't help, please post a regedit export, name your OS & perl version - and I'll look deeper...

Hi Martin
Thanks for the reply.
Once I exported the registry file I saw the problem, I had a quote in there that shouldn’t have been there.
All tested and working great now. Thanks for the solution to the Tnef problem.

Seems like step 4 no longer works like it is supposed to. I tried to install the one piece of evidence of TNEF (tnef.pm) and Perl indicates that the file doesn't exist. Some syntax has changed... Need some solution to this please.

Are you using perl 5.10? The www.roth.net packages (windows service handling) aren't compatible with ActiveState 5.10 -- 5.8 should still be Ok. I'll look into a 5.10 compatible solution but it's not likely to be in the near future.

Also, looking today, TNEF::Convert installs with "Convert-TNEF" whereas 'Convert-TNEF' worked in the past. Strange.

I've edited the original post to show the changes.

I am now using 5.6.1 build 638. Followed the instructions and I still get hung up on step 4. Is there a script (tnefdoecode.pl) that I make, or is there an existing one that I just copy?

I assume that the attachment was lost in the forum upgrade. I just tried to re-attach to the original post but I'm getting an error message...

The selected file TnefDecode-2007-11-18.zip could not be uploaded. The file is 6.68 KB which would exceed your disk quota of 30 MB.

... so here's the script.

# tnefdecode.pl
# 
# TnefDecode Mailtraq Message Filter handler
# convert TNEF parts to standard MIME
# Pass mail messages from Inqueue to OutQueue directories
#
# Martin Clayton
# =============================================================================

 my $VERSION = 20071118;
 
 use strict;
 use warnings;

 use Win32;
 use Win32::TieRegistry;    # seems to ship with activestate default
 use File::Copy;
 
 # this version drops ChangeNotify and relies on Win32::Daemon callbacks to the Service Control Manager 
 # use Win32::ChangeNotify;   # seems to ship with activestate default
 
 use MIME::Parser;          # ppm> install MIME-tools 
 use Convert::TNEF;         # ppm> install TNEF-Convert (not Convert-TNEF)
 use MIME::Types;           # ppm> install MIME-Types

 # new for service edition
 use Getopt::long;          # ppm> install Getopt-Long 
 use Win32::Daemon;         # ppm> install <a href="http://www.roth.net/perl/packages/win32-daemon.ppd" title="http://www.roth.net/perl/packages/win32-daemon.ppd">http://www.roth.net/perl/packages/win32-daemon.ppd</a>
 use Win32::perms;          # ppm> install <a href="http://www.roth.net/perl/packages/win32-perms.ppd" title="http://www.roth.net/perl/packages/win32-perms.ppd">http://www.roth.net/perl/packages/win32-perms.ppd</a>


# configuration vars
# =============================================================================

 # Defaults. %Config values can/will be overwritten by service install command line parameters
 
 my %Config = (
     user       => '',     # Win32 service user account to run under
     password   => '',     # Win32 user account password
     #activate   => 0,      # write ".active" file to InQueue on start-up
     #mtqlog     => 1,      # output .file for mailtraq log entry on tnef conversion or mime error
     #headers    => 1,      # add X-MTQ-TnefDecode header, delete X-MS-TNEF-Correlator
     freq       => 2,      # InQueue monitoring interval (seconds)
     logfile    => '',     # full path for service log_file (if set, over-rides default)
 );   
 
 # mtq log prefix
 my $mtq_log_info  = "00010000 00000000 MessageFilter: TnefDecode"; 
 my $mtq_log_alert = "00000800 00000000 MessageFilter: TnefDecode";

 
# set-up 
# =============================================================================

# read mtq message-filter locations
# -----------------------------------------------------------------------------
 
 my $key = new Win32::TieRegistry "LMachine/Software/Fastraq/Mailtraq/MessageFilters/TnefDecode",
           { Delimiter => "/" } or die "Can't read registry TnefDecode key $!\n";

 my $in_q = $key->GetValue("InQueue") or die "Can't read registry InQueue value: $^E";
 my $out_q = $key->GetValue("OutQueue") or die "Can't read registry OutQueue value: $^E";


# check directory locations
# -----------------------------------------------------------------------------

 # strip any trailing slashes from InQueue & OutQueue values 
 $in_q =~ s/(.*)\\$/$1/;
 $out_q =~ s/(.*)\\$/$1/;
 
 # set mime & tnef temp directories on the same level as /inqueue
 my $root_dir = $in_q;
 $root_dir =~ s/^(.*\\.*)\\.*$/$1/;
  
 my $mime_dir = $root_dir . "\\tmp-mime";
 my $tnef_dir = $root_dir . "\\tmp-tnef";
 
 # store for messages that mime-decoder can't handle
 my $prob_dir = $root_dir . "\\unparsable-mime";

# parse command line options
# -----------------------------------------------------------------------------

 Getopt::Long::Configure( "prefix_pattern=(-|\/)" );
 my $CommandLine = 
    Getopt::Long::GetOptions( \%Config,
                              qw( 
                                  install|i
                                  remove|r
                                  user|u=s
                                  pass|password|p=s
                                  activate|a
                                  logfile|log|l=s
                                  freq|f=i
                                  headers|hdrs
                                  mtqlog|m
                                  help|?|h
                                )
                            );

 # run help on request or unrecognised parameter
 $Config{help} = 1 if( ! $CommandLine || scalar @ARGV );
 if( $Config{help} ) 
 {
     Syntax();
     exit();
 }

 if( $Config{remove} ) 
 {
     Remove();
     exit();
 }

 # create directories if needed
 check_dir($in_q, $out_q, $tnef_dir, $mime_dir);

 # set the default logging file if none is given
 if ( ! $Config{logfile}  ) 
 {
      $Config{logfile} =  $root_dir . "\\" . "TnefDecode.log";
 }

 # add service 
 if( $Config{install} ) 
 {
     Install();
     exit();
 }

 # Service mode from here
 
 # -----------------------------------------------------------------------------
 # Redirect STDOUT and STDERR to the log file
 # open( STDOUT, ">>$Config{logfile}" ) or die "Couldn't open $Config{logfile} for appending: $!\n";
 # open( STDERR, ">&STDOUT" );
 #
 # Can't seem to get any writes to STDOUT or STDERR under Win32 service
 # so revert to explicit LOG file
 
 open( LOG, ">>$Config{logfile}" ) or die "Couldn't open $Config{logfile}: $!\n";
 
 # Autoflush, no buffering
 $|=1;

 print LOG "# ----------------------------------------------------------" . "\n" .
           "# TnefDecode.pl v $VERSION starting"                          . "\n" .
           "# ----------------------------------------------------------" . "\n"
           or die "Can't write to $Config{logfile} $!";
 close(LOG) or die "Can't close log file $!\n";
 
# LogItem("Getting ready for service start-up"); 

# set-up mime handlers
# -----------------------------------------------------------------------------

 my $parser=new MIME::Parser;
 $parser -> output_dir( $mime_dir );
 
 # prefix for files with auto-generated names
 # $parser -> output_prefix( "TnefDecode-" );  # now deprecated, go evil
 $parser->filer->evil_filename("TnefDecode-");
 
 my $mimetypes = MIME::Types->new;
 
 # initialise notification object
 #my $notify = Win32::ChangeNotify -> new( $in_q, 0, "FILE_NAME" );
 #if( ! $notify ) 
 #{
 #   print LOG get_time() . " ! Failed to initiate InQueue directory monitor for " . $in_q . "\n";
 #   print LOG "! Error: " . GetError() . "\n";
 #   exit();
 #}

 # Turn off hard core domain controller lookups # MC: wonder why
 Win32::Perms::LookupDC( 0 );

 # Define callback routines for SCM monitor
 Win32::Daemon::RegisterCallbacks( {
                start       =>  \&Callback_Start,
                running     =>  \&Callback_Running,
                stop        =>  \&Callback_Stop,
                pause       =>  \&Callback_Pause,
                continue    =>  \&Callback_Continue,
         } );
 
 # context for service calls
 my %Context = (
      count      => 0, 
      last_state => SERVICE_STOPPED,
      start_time => time(),
    );
    
 # Start the service with a context and request callbacks 
 # to the 'Running' event with the Config polling interval
 if( ! Win32::Daemon::StartService( \%Context, $Config{freq} * 1000 ) ) 
 {
    LogItem( "! Failed to start script as a Win32 service" );
    LogItem( "! Error: " . GetError() );
    exit();
 }

 # Service has now stopped
 LogItem( "Normal service shutdown" );
 
 exit();

# ====================================================================
# Callback event handlers 
# ====================================================================

 sub Callback_Start  
 {
       
    my ( $Event, $Context ) = @_;        
     
    # write .active file
    if ( $Config{ activate } ) 
    {
        LogItem("Service start-up writing .active file"); 
        outqueue_dotfile('active', $in_q, '');
    }
             
    $Context -> {last_state} = SERVICE_RUNNING;
    Win32::Daemon::State( SERVICE_RUNNING );
 }

 sub Callback_Running 
 {

    my ( $Event, $Context ) = @_;
     
    if( SERVICE_RUNNING == Win32::Daemon::State() ) 
    {
          
        $Context -> {count}++;
        #my $monitor = $notify->wait( $Config{freq} * 1000 );
        #if( $monitor ) {
            process_files();
        #    $notify->reset();
        #}
    }

 }    
  
 sub Callback_Pause 
 {
 
    my( $Event, $Context ) = @_;

    LogItem("Service paused");

    $Context -> {last_state} = SERVICE_PAUSED;
    Win32::Daemon::State( SERVICE_PAUSED );

 }

 sub Callback_Continue 
 {
 
    my( $Event, $Context ) = @_;
    
    LogItem("Service resuming");
            
    $Context -> {last_state} = SERVICE_RUNNING;
    Win32::Daemon::State( SERVICE_RUNNING );

 }

 sub Callback_Stop 
 {
 
    my( $Event, $Context ) = @_;
     
    LogItem("Service closing down");
     
    #$notify -> close();
     
    $Context -> {last_state} = SERVICE_STOPPED;
    Win32::Daemon::State( SERVICE_STOPPED );
            
    # Stop callbacks and the service
    Win32::Daemon::StopService();
    
 }


# ====================================================================
# other subs
# ====================================================================

 sub process_files  
 {
 
    # pick up valid files in the inqueue, pass to entity processor,
    # write to outqueue
     
     opendir(DIR, $in_q) or die "Can't open $in_q: $!";
     
     #my @files = map { $in_q . "/" . $_ }
     my @files = map { $_ }
                 grep { !/^\./ }         # ignore all files starting with "."
                 readdir DIR;
     closedir DIR or die "Can't close $in_q: $!";
     
     # mime-parser entity to be
     my $entity;
     
     for my $file ( @files ) {
        
         
        # test mime entity creation, abort on non-creation
        eval { $entity = $parser->parse_in($in_q . "/" . $file) };
        if (!$entity) 
        {
          skip_unparsable_message($file);
          next;
        }
         
        # counter for number of tnef parts
        my $conversions = 0;
        my $conversions_ref = \$conversions;
         
        # entity processor; add decoded parts 
        $entity = decode_tnef_parts($entity, $conversions_ref);
         
        if ($conversions) 
        {
         
          # update headers
          if($Config{headers}) 
          {
            $entity -> head -> replace('X-MTQ-TnefDecode', "$file $conversions TNEF attachments converted");
            if ($entity -> head-> count('X-MS-TNEF-Correlator')) 
            {
              $entity -> head -> delete('X-MS-TNEF-Correlator');
            }
          }
           
          # write .file for mtq log entry
          if($Config{mtqlog}) 
          {
            outqueue_dotfile($file."-log", $out_q, "$mtq_log_info $file $conversions TNEF attachments decoded");
          }
           
          # tell the service log about our great success
          LogItem("$file $conversions TNEF attachments decoded");
          
          # write new mime entity to outqueue
          my $filename = "$out_q\\$file";
          open( OUT, ">" . $filename ) or die "Can't open ouput file ($filename) \$";
          if ( ! print OUT $entity -> as_string ) 
          {
            die "Can't write output file ($filename) $!";
          }
          close(OUT) or die "Can't close output file ($filename) \$";
          # delete input message from inqueue
          unlink $in_q."\\".$file or die "Couldn't delete input file ($in_q\\$file) $!";
         
        } else {
        
          # move unconverted file to outqueue
          if (!rename $in_q."\\".$file, $out_q."\\".$file) 
          {
            die "Can't write output file (" . $out_q."\\".$file . ")! $!";
          }
         
        }
         
        # delete temp mime-decoder part files
        if ($entity) 
        {  
          $entity -> purge;
        }
      
     } 
   
 }

# ====================================================================

 sub skip_unparsable_message {

    # mime-decoder can't handle this message. Report 'unparsability' 
    # (optionally), move file to outqueue  
    
    my $file = shift;

    # write mtq log entry
    if( $Config{mtqlog} ) 
    {
      outqueue_dotfile($file."-log", $out_q, "$mtq_log_alert $file can't decode mime structure");
    }

    # tell the service log about our dismal failure
    LogItem("$file skipped; could not discern mime structure");
 
    # store a copy of the errant file
    check_dir($prob_dir);
    copy($in_q."\\".$file, $prob_dir) or die "Couldn't copy $file to $prob_dir $!";
 
    # move file to outqueue
    if (! rename $in_q."\\".$file, $out_q."\\".$file) 
    {
      die "Can't write output file (" . $out_q."\\".$file . ")! $!";
    }
    
    #clean up mime decoder temp dir
    opendir(DIR, $mime_dir) or warn "Can't open $mime_dir to clean up: $!";
    my @tmp_files = grep(!/^\.\.?$/, readdir DIR) or warn "Can't read $mime_dir to clean up: $!";
    for my $tmp_file ( @tmp_files ) 
    {
      unlink $mime_dir."\\".$tmp_file or warn "Couldn't delete file ($mime_dir\\$tmp_file) $!";               
    }
 
 }
 
# ====================================================================

 sub decode_tnef_parts 
 {
   
   # examine mime entity parts, convert any tnef parts, add results 
   # to entity (new parts), discard tnef parts
 
   my( $ent, $conversions_ref ) = @_;
   my @non_tnef_parts;                 # used to remove tnef parts
  
   # recursion for sub-entities   
   if ( $ent -> parts ) 
   { 
     for my $sub_ent ( $ent->parts ) {
       decode_tnef_parts($sub_ent, $conversions_ref);
     }
     
   } elsif ( $ent -> mime_type =~ /ms-tnef/i ) 
   {
     
     # Create tnef object
     my %TnefOpts = ( 'output_dir' => $tnef_dir );
     my $tnef = Convert::TNEF->read_ent( $ent, \%TnefOpts )
                or die "Tnef conversion error: $Convert::TNEF::errstr";
     
     # set new mime part properties
     for ( $tnef -> attachments ) 
     {
     
       $_ -> longname =~ /^[\w\W]+\.(\w+)$/;
       my $ext = $1;
       my $type = $mimetypes->mimeTypeOf($ext);
       if (! $type) 
       {
         warn "No MIME type for (" . $_ -> longname . "/" . $_->name . ")\n";
         $type = "application/octet-stream";
       }
        
       my $encoding;
       if ( $type ) 
       {
         if ( $type =~ m,^text/, ) 
         {
           if ( $_->data =~ /[^\001-\177]/ ) 
           {
             $encoding = '8bit';
           } else 
           {
             $encoding = '7bit';
           }
         } else 
         {
           $encoding = 'base64';
         }
       } elsif ( $_ -> data =~ /[^\t\n\r\f\040-\177]/ ) 
       {
           $encoding = 'base64';
       } else 
       {
         $encoding = '7bit';
       }
      
       # add part to main entity
       $ent -> attach( Type => $type,
                       Encoding => $encoding,
                       Disposition => 'attachment',
                       Filename => $_->longname,
                       Data => $_->data
                     );
     }
     
     # delete working files
     $tnef -> purge;
     $ent -> purge;
     
     # increment conversion count
     $$conversions_ref++;
     
   }     
      
   # store non-tnef parts in array
   my @parts = $ent -> parts;
   foreach my $part ( @parts ) 
   {
	  my $part_head = $part -> head;
      if ( $part_head -> mime_type !~ /ms-tnef/i ) 
      {
           push @non_tnef_parts, $part;
      }
   }
   # remove tnef parts
   if ( $conversions_ref ) 
   {
        $ent -> parts( \@non_tnef_parts );
   }
     
  return $ent;
     
 }

# ====================================================================

 sub check_dir 
 {

    my @dirs = @_;
     
    for my $path ( @dirs ) 
    {
      if (! -d $path ) 
      {
     
        warn  "Directory not found: $path \n";
        mkdir( $path, 0755 ) or die "Couldn't create directory: $path - $!"; 
        print "- Directory created: $path \n";
        check_dir( $path );
     
      } else {
     
        opendir( DIR, $path ) or die "Can't open $path - $!";
        closedir DIR or die "Can't close $path - $!";   
     
      }
     
    }
   
 }

# ====================================================================

 sub outqueue_dotfile 
 {
 # write .file to OutQueue, expects filename (without leading "."), 
 # queue location and message content
 
    my $dot_filename = shift;
    my $location = shift;
    my $message = shift;
     
    my $dot_file = $location . '\\.' . $dot_filename;
    open(OUT, ">" . $dot_file) or die "Can't open ouput file (" . $dot_file . ") \$";
    if ( ! print OUT $message ) 
    {
      die "Can't write output file (" . $dot_file . "). $!";
    }
    close(OUT) or die "Can't close output file (" . $dot_file . "). \$";
 
 }


# ====================================================================

 sub get_time 
 {
    # courtesy of Jim Hill
    my ($sec,$min,$hr,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
    my $out = ($year + 1900)."-".sprintf("%02d", $mon)."-".sprintf("%02d", $mday)." ".sprintf("%02d", $hr).":".sprintf("%02d", $min).":".sprintf("%02d", $sec);
    return $out;
 }

# ====================================================================

 sub LogItem 
 {
    my $info = shift;
    open( LOG, ">>$Config{logfile}" ) or die "Couldn't open $Config{logfile}: $!\n";
    print LOG get_time() . " " . $info  . "\n" or die "Can't write log $!";
    close( LOG ) or die "Can't close logfile $!";
 }

# ====================================================================

 sub GetError 
 {
     return( Win32::FormatMessage( Win32::Daemon::GetLastError() ) );
 }


# ====================================================================
# service installation routines
# ====================================================================

 sub GetServiceConfig 
 {

    my $ScriptPath = join( '', Win32::GetFullPathName( $0 ) );
 
    my $params = "$ScriptPath -f $Config{freq} -l \"$Config{logfile}\"";

    if ( $Config{activate} ) 
    {
      $params .= ' -a';
    }
    if ( $Config{headers} ) 
    {
      $params .= ' -hdrs';
    }
    if ( $Config{mtqlog} ) 
    {
      $params .= ' -m';
    }

    my %ServiceConfig = (
        name          => "TnefDecode",
        display       => "TnefDecode",
        description   => "Mailtraq Message Filter service to decode TNEF mail messages",
        path          => $^X,
        user          => $Config{user},
        password      => $Config{password},
        parameters    => $params,
        service_type  => SERVICE_WIN32_OWN_PROCESS,
        start_type    => SERVICE_AUTO_START,
    );
    return( \%ServiceConfig );
 }

 sub Install 
 {

    my $ServiceConfig = GetServiceConfig();
    
    if( Win32::Daemon::CreateService( $ServiceConfig ) ) 
    {
        print "The $ServiceConfig->{name} service was successfully installed" . "\n\n" .
              "To start the service use the Service Control Manager or"       . "\n" .
              "run 'net start tnefdecode' at the command line."               . "\n";
    } else 
    {
        print "Failed to add the $ServiceConfig->{name} service." . "\n" .
              "Error: " . GetError()                              . "\n";
    }

 }

 sub Remove 
 {

   my $ServiceConfig = GetServiceConfig();
    
   if( Win32::Daemon::DeleteService( $ServiceConfig->{name} ) ) 
   {
       print "The $ServiceConfig->{name} service was successfully removed.\n";
   } else 
   {
       
       my $ErrorType = GetError();
       print "Failed to remove the $ServiceConfig->{name} service." . "\n" . 
             "Error: " . $ErrorType . "\n";
             
         if ( $ErrorType =~ m/service has been marked for deletion/i  ) 
         {
              print 
              " You need to reboot before the service will be removed. You might be" . "\n" .
              " able to avoid this in future by stopping the service or closing the" . "\n" .
              " Service Management Console before running $0 -remove"                . "\n";
         }
   }
  
 }


# ====================================================================
# help
# ====================================================================

 sub Syntax {
    my( $Script ) = ( $0 =~ m#([^\\/]+)$# );
    my $Line = "-" x length( $Script );
    print << "EOT";

$Script
$Line
Mailtraq Message Filter handler to decode TNEF attachments (usually, winmail.dat). 
Monitors InQueue directory for new files, decodes and outputs to OutQueue. Runs 
as a Win32 service 'TnefDecode'. Use the Service Control Manager or net start|stop 
at the command line.

Syntax:
    $0 [ [-install] [-remove] [-user <User> -pass <Pwd>] [-f <Time>] [-a] [-h] [-m] [-log <Path>] ]

    Service settings
    -install....... Installs script as a Win32 service. Any other options 
                    given will apply when the service runs.
    -remove........ Removes the script's Win32 service.
    -user <User>... User account the service is to run under.
                    Default: uses system account when nothing is set
    -pass <Pwd>.... User account password.
                    Default: uses system account when nothing is set
    -f <Time>...... Frequency in seconds to scan the InQueue. This is the 
                    interval used by the service to check for changes issued 
                    by the windows Service Control Manager. High values, say
                    10+ seconds, may not give the service enough time to
                    shutdown cleanly. Default: 2 seconds when nothing is set
    Runtime   
    -a............. Automatically activate the Mailtraq Filter on start-up
                    by writing an ".active" file to the InQueue. 
    -hdrs.......... Sets X-MTQ-TnefDecode header and deletes X-MS-TNEF-Correlator 
                    on conversion. Sets error message for unparsable MIME.
    -m............. Output Mailtraq log entry on tnef conversion and mime error
    -l <Path>...... Log file location for service. Overrides the default:
                    $Config{log}
    -h............. Help.  

    Examples:
    perl $0 -install
    perl $0 -install -f 5 -a -h -m -l F:\\logs\\MTQ\\TnefDecode.txt
    perl $0 -user Domain\\User -pass UserPassword

Credits:
  Mime handling
    TNEF decoding: killtnef-1.0.3
    <a href="http://www.cpan.org/authors/id/H/HI/HIGHTOWE/killtnef-1.0.3.pl" title="http://www.cpan.org/authors/id/H/HI/HIGHTOWE/killtnef-1.0.3.pl">http://www.cpan.org/authors/id/H/HI/HIGHTOWE/killtnef-1.0.3.pl</a>

  Mailtraq Message Filter directory monitoring
    Jim Hill, shunt.pl Mailtraq Message filter
    <a href="http://rdns.org/mailtraq/perl/shunt/" title="http://rdns.org/mailtraq/perl/shunt/">http://rdns.org/mailtraq/perl/shunt/</a>

  Win32 Daemon & command line options 
    Dave Roth (rothd\@roth.net), Roth Consulting, <a href="http://www.roth.net/" title="http://www.roth.net/">http://www.roth.net/</a>
EOT

 }

# ====================================================================
# EOF