Re: Exchange Metabase access with Perl

[Patrick J. LoPresti]

Eric Hennessey <[EMAIL PROTECTED]> writes:

> Has anyone out there ever manipulated the Exchange 2000 metabase through
> perl?  Any help would be most appreciated.

No, but I have written a script to modify the IIS metabase.  You call
it with an extension and a MIME type and it will add it to the IIS
MIME map.  (It also does much, much more error checking than the VB
code on which it is based...  But that is beside the point.)

Manipulating the Exchange 2000 metabase may be similar.  Or then
again, it may not :-).

Hope this helps.

 - Pat


#!/usr/local/bin/perl

# Script to modify the IIS file extension to MIME type map.

# Based on the sample code in the documentation for the IIsMimeMap
# class:
#
#   http://www.microsoft.com/windows2000/en/server/iis/htm/asp/aore8m5s.htm
#
# (found by doing a Google search for "IIsMimeMap").

use warnings;
use strict;
use Getopt::Long;
use Pod::Usage;
use Win32::OLE;

# Your usual option-processing sludge.
my %opts;

GetOptions (\%opts, 'help', 'man', 'force')
    or pod2usage (2);

# Display help if requested.
(exists $opts{'help'})
    and pod2usage (0);
(exists $opts{'man'})
    and pod2usage ('-exitstatus' => 0, -verbose => 2);

# Ensure an even number of (and at least two) arguments after options.
@ARGV % 2 == 0 && @ARGV > 1
    or pod2usage (1);

# Get new extension -> type mappings.
my %new_mappings = @ARGV;

# Canonicalize an extension to begin with dot and be all lower-case.
sub canonicalize_ext ($) {
    my ($ext) = @_;
    $ext =~ tr/A-Z/a-z/;
    $ext =~ /^\./
        or $ext = ".$ext";

    return $ext;
}

# Apply canonicalization to command-line arguments.
foreach my $ext (keys %new_mappings) {
    my $new_ext = canonicalize_ext ($ext);

    $ext eq $new_ext
        and next;

    $new_mappings{$new_ext} = $new_mappings{$ext};
    delete $new_mappings{$ext};
}

# Bomb out completely if COM engine encounters any trouble.
Win32::OLE->Option ('Warn' => 3);

# Get a copy of the default IIS MIME map from the metabase.
my $mimemap_obj = Win32::OLE->GetObject ('IIS://localhost/mimemap');
my $mimemap = $mimemap_obj->{'MimeMap'};

# Overall exit status.
my $failed = 0;

# Set of extensions which we have finished.
my %finished;

# Loop through current MIME map looking for mappings to replace.
foreach my $mapping (@$mimemap) {
    my $ext = canonicalize_ext ($mapping->{'Extension'});

    # Skip unrelated mappings.
    (exists $new_mappings{$ext})
        or next;

    # We already have a mapping for this extension, which we will
    # either replace or ignore; either way, we no longer care about
    # this extension.
    $finished{$ext} = undef;

    # See if the current MIME type matches the desired one for this
    # extension.
    my $cur_type = $mapping->{'MimeType'};
    my $new_type = $new_mappings{$ext};

    if ($cur_type eq $new_type) {
        warn "$ext already maps to $new_type; skipping\n";
        next;
    }

    # They do not match, so...
    if (exists $opts{'force'}) {
        warn "$ext maps to $cur_type; replacing with $new_type\n";
        $mapping->{'MimeType'} = $new_type;
    }
    else {
        warn "FAILURE: $ext maps to $cur_type (should be $new_type); skipping\n";
        $failed = 1;
    }
}

# Now go through the remaining new mappings and create them.
foreach my $ext (sort keys %new_mappings) {
    # Skip extensions which we already handled.
    (exists $finished{$ext})
        and next;

    # Create the new mapping and add it to the MIME map.
    my $new_type = $new_mappings{$ext};

    my $new_mapping = Win32::OLE->CreateObject ('MimeMap');
    $new_mapping->{'Extension'} = $ext;
    $new_mapping->{'MimeType'} = $new_type;

    push @$mimemap, $new_mapping;
}

# Update our copy of the MIME map object.
$mimemap_obj->{'MimeMap'} = $mimemap;

# Commit our copy of the MIME map object to the metabase.
$mimemap_obj->SetInfo ();

exit 0;

__END__

=head1 NAME

add-iis-mimemap - Create file extension to MIME type mappings in IIS server

=head1 SYNOPSIS

  add-iis-mimemap [ options ] <extension> <mime-type> ...

=head1 OPTIONS

    --help      display this help and exit
    --force     Replace current mapping, if any

=cut