Knowledgetree Command Line Drop Box in Perl

I needed an easy way to push documents to the KT implementation. After looking at how KT’s windows drop box software works I wrote something similar in Perl that works from the command line.

I plan to wrap an Automator action around this to upload documents easily.

#stephen
#www.stephenjc.com
#ktdrop.pl
#command line drop box
#usage: ./ktdrop.pl username password fullpath_to_file

use SOAP::Lite;
use Data::Dumper;
use LWP::UserAgent;
use HTTP::Request::Common;
use XML::Simple;

#username and password for KT
$username = $ARGV[0];
$password = $ARGV[1];

#prefix http or https
$serverPre = 'https://';

#full server url with port
$serverUrl = 'server.com:port/kt';

#document type for uploaded documents, make sure nothing is required because we will not send any metadata
$ktDocumenttype = 'default';

#if you have http basic leave this, otherwise change it to ''
$httpAuth = $username . ':' . $password . '@';
$fullUrl = $serverPre.$httpAuth.$serverUrl.'/ktwebservice/';
$session = SOAP::Lite->new(proxy => $fullUrl . 'webservice.php?wsdl');

$file = $ARGV[2];

#login
$r = $session->login($username,$password,'127.0.0.1');
$ktsessionid = $r->valueof('//message');

#dropbox folder id for user
$r = $session->get_folder_detail_by_name($ktsessionid,"DroppedDocuments/$username");
$dropboxid = $r->valueof('//id');

#upload document
$uploadRes = ktUpload();

#move file to dms
$r = $session->add_document($ktsessionid,$dropboxid,$uploadRes->{name},$uploadRes->{name},$ktDocumenttype,$uploadRes->{filename});
if ($r->valueof('//status_code') == 0)
{
$r = $session->logout($ktsessionid);
exit(0);
}
else
{
print "The upload did not work\n";
exit(1);
}

sub ktUpload
{
my $ua = LWP::UserAgent->new;
my $browser = HTTP::Request->new();
my $response = $ua->request(POST $fullUrl . 'upload.php',
Content_Type => 'form-data',
Content =>[
session_id => $ktsessionid,
action => "A",
output => "xml",
file => [$file]
]
);
my $uploadres = XMLin($response->content);
#print Dumper($uploadres->{upload_status}->{file});
return $uploadres->{upload_status}->{file};
}

Create exchange accounts from Perl

I have not been able to create MS Exchange 2007 accounts from perl, the only method i have found that works is to call the PowerShell command to create the account. Below is an example.

system qq[PowerShell.exe -PSConsoleFile "C:\\Program Files\\Microsoft\\Exchange Server\\Bin\\ExShell.psc1" -Command ". {Enable-Mailbox -Identity fitsuny\\] . $adUser->samaccountname . qq[ -Alias ] . $adUser->samaccountname . qq[ -Database $database] . $value. qq[}"];

DKIM signing in perl

MT Hosting
#[email protected]
#Simple DKIM
#V0.1

use Mail::DKIM::Signer;
use Email::Simple;

@ARGV == 1 or die "Missing File Name";

$domain = "mysecureservice.com";
$key = "C:\\Ahsay\\CustomScripts\\$domain.priv";
$dkimsel = "dkim";
$dksel = "dk";
my $dkim = Mail::DKIM::Signer->new(
Algorithm => "rsa-sha1",
Method => "relaxed", 
Domain => $domain, 
Selector => $dkimsel, 
KeyFile => $key);

open(mail,"< $ARGV[0]");
$emailm = "";

while ()
{
chomp;
s/\015$//;
$dkim->PRINT("$_\015\012");
$emailm = "$emailm"."$_\n";
}
$dkim->CLOSE;
close mail;

my $email = Email::Simple->new($emailm);
$dkimsig = $dkim->signature->as_string();
$dkimsig =~ s/DKIM-Signature: //;

$email->header_set("DKIM-Signature", $dkimsig);


open (mail, "> $ARGV[0]");
$emailmsg = $email->as_string;
#$emailmsg =~ s/\015$//;
print mail $emailmsg;
close mail;

Imail orphan cleaner in Perl

This perl script will compare your active directory and your imail directory. Any accounts that do not exist in AD will be moved to your orphan directory and their registry settings will be exported and deleted.

Logon Tracker

This is the client part of a script that collects the username and computer name and sends it to a database for tracking purposes, when I find the server side of the script I will post that also.

#!/usr/bin/perl
#Grabs Certain local data and send it to an ICC database.

$user = $ENV{'USER'};
use Sys::Hostname;

use LWP::UserAgent; 
my $ua = new LWP::UserAgent;

my $response
= $ua->post('http://web.url.com/getlinfo.asp',
{ user => $user,
machine => hostname,
});

my $content = $response->content; 

Using perl to Parse AD’s UserAccountControl field

To parse the UserAccountControl field in Active Directory you have to use a bit-wise and of “&” and not “&&” to check the value. Below are some examples Here is a MSDN page that has more information.

This MS site also has more values listed.

#Check if the account is Disabled
$strStatus & 2

#Check if the account is Locked
$strStatus & 16

Perl POP3 collector

This collects multiple pop3 email accounts and sends them to an smtp server. I wrote this as an exchange pop3 collector.

Setup:
1. Set $inserver to your incoming mail server to collect the pop3 email from. If you need to collect from multiple pop3 servers just copy the script and run them separately.
2. Set $outserver to the server that you would like to move the email to. It does not have to be a local server.
3. Set the %accounts array with the pop3 account you would like to collect.
If you are collect multiple pop3 accounts %accounts might look like this.

%accounts = (
            '[email protected]' => {'password' =>  'pop3_pass','sendto' =>  'demo@demo_exchange.local',},
             '[email protected]' => {'password' =>  'demo2_pass','sendto' =>  'demo2@demo_exchange.local',},
            ); 
#Usage: Run this as a scheduled task to collect external pop3 email and move them into exchange.
use Net::POP3;
use Net::SMTP;

#1 = turn debug on || 0 = turn debug off
#to check for errors run the this from the command line. Example:
# perl exchangepop.pl 1>>expop.log 2>>expop.log
$debug=0;

$inserver="mail.gmail.com"; #email server to get email from

$outserver="localhost"; #Exchange Server, this is usually localhost.

#Accounts to Collect e-mail from, Example:
# 'Pop3 user name' => {'password' =>  'Pop3 Password','sendto' =>  'Exchange E-mail Address',},
%accounts = (
           '[email protected]' => {'password' =>  'pop3_pass','sendto' =>  'demo@demo_exchange.local',},
           );

foreach $accnt (keys %accounts)
{
#print "User: $accnt password:", $accounts{$accnt} -> {"password"}, " sendto: ",$accounts{$accnt} -> {"sendto"}," \n";

  $pop = Net::POP3->new($inserver,Timeout => 60, Debug => $debug);
   if ($pop->login($accnt, $accounts{$accnt} -> {"password"}) > 0)
   {
       my $msgnums = $pop->list;
       foreach my $msgnum (keys %$msgnums)
       {
           my $msg = $pop->get($msgnum);
           $smtp = Net::SMTP->new($outserver, Timeout => 60, Debug =>$debug);
           $smtp->mail($accnt);
           $smtp->to($accounts{$accnt} -> {"sendto"});
           $smtp->data();
           $smtp->datasend(@$msg);
           $smtp->dataend();
           $smtp->quit;
           $pop->delete($msgnum);
       }
   }
   $pop->quit;
}
print "done!";

Active directory web password reset

This is a simple webform that asks for the username and when you click submit it will generate a random password.

default.htm






FIT Password Reset






FIT Username:








All usage is monitored and logged.





fitPassReset.pl