[Bps-public-commit] app-wsgetmail branch branch-for-multiple-improvements created. 0.06-4-g64a76d8
BPS Git Server
git at git.bestpractical.com
Mon Sep 19 15:30:47 UTC 2022
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "app-wsgetmail".
The branch, branch-for-multiple-improvements has been created
at 64a76d8128d904a2827fe61ad08057841d84b478 (commit)
- Log -----------------------------------------------------------------
commit 64a76d8128d904a2827fe61ad08057841d84b478
Author: Brian Conry <bconry at bestpractical.com>
Date: Mon Sep 19 09:05:06 2022 -0500
Add config option strip_cr
This option directs wsgetmail to convert CRLF line endings in the
fetched message to LF line endings. The default value is to preserve
CRLFs in fetched messages.
This behavior is tenchnically non-standard according to the MIME and
SMTP standards, but is the default behavior for at least one other mail
fetching utility and some *nix programs commonly used for mail
processing don't properly handle messages with CRLFs.
diff --git a/Changes b/Changes
index 4350586..68cd096 100644
--- a/Changes
+++ b/Changes
@@ -1,6 +1,7 @@
Revision history for App-wsgetmail
0.07 ??/??/??
+ * Add strip_cr option to convert CRLF -> LF
* Add locking based on the config file to prevent multiple instances
from running on the same account/mailbox at the same time.
* Remove '+ 5' adjustment to timeout in MDA.pm
diff --git a/lib/App/wsgetmail.pm b/lib/App/wsgetmail.pm
index 5d5c75d..ec71d72 100644
--- a/lib/App/wsgetmail.pm
+++ b/lib/App/wsgetmail.pm
@@ -73,6 +73,7 @@ where C<wsgetmail.json> looks like:
"global_access": 1,
"username": "rt-comment at example.com",
"folder": "Inbox",
+ "strip_cr": 0,
"command": "/opt/rt5/bin/rt-mailgate",
"command_args": "--url=http://rt.example.com/ --queue=General --action=comment",
"command_timeout": 30,
@@ -411,6 +412,14 @@ configuration file.
Set this to the name string of a mail folder to read.
+=item strip_cr
+
+Set this to 1 to make wsgetmail convert the messages from the CRLF
+line-ending encoding to the LF line-ending encoding.
+
+This is technically not standards-compliant, but some unix utilities
+don't work with CRLF line-endings.
+
=item command
Set this to an executable command. You can specify an absolute path,
diff --git a/lib/App/wsgetmail/MS365.pm b/lib/App/wsgetmail/MS365.pm
index c2cb7c2..98cb8bc 100644
--- a/lib/App/wsgetmail/MS365.pm
+++ b/lib/App/wsgetmail/MS365.pm
@@ -186,6 +186,18 @@ has post_fetch_action => (
required => 1
);
+=head2 strip_cr
+
+A boolean. If true, the message content will have CRLF line terminators
+converted to LF line terminators.
+
+=cut
+
+has strip_cr => (
+ is => 'ro',
+ required => 0,
+);
+
=head2 debug
A boolean. If true, the object will issue a warning with details about each
@@ -238,7 +250,7 @@ around BUILDARGS => sub {
grep {
defined $config->{$_}
}
- qw(client_id tenant_id username user_password global_access secret folder post_fetch_action debug)
+ qw(client_id tenant_id username user_password global_access secret folder post_fetch_action strip_cr debug)
};
return $class->$orig($attributes);
@@ -296,7 +308,9 @@ sub get_message_mime_content {
# can we just write straight to file from response?
my $tmp = File::Temp->new( UNLINK => 0, SUFFIX => '.mime' );
- print $tmp $response->content;
+ my $content = $response->content;
+ $content =~ s/\r$//mg if $self->{strip_cr};
+ print $tmp $content;
return $tmp->filename;
}
commit b96c347569d699d0d8c5f24ec691eeeb0a7d4283
Author: Brian Conry <bconry at bestpractical.com>
Date: Fri Sep 16 16:27:47 2022 -0500
Add file locking to prevent contention
This change adds file locking based on the configuration file to prevent
multiple isntances running simultaneously on the same username/folder
while still allowing multiple instances to run as long as they have
distinct configuration files.
The Microsoft Graph API is based on REST, which is stateless so there's
nothing at the remote endpoint that will prevent multiple instances of
an application from working in parallel.
In order to reduce the number of remote data fetches, wsgetmail executes
a search and pulls down a worklist of messages before it starts
processing the first message. This decision means that multiple copies
of wsgetmail working on the same username/folder can have overlapping
sets of messages, leading to messages being processed multiple times.
The locking prevents this as long as multiple config files don't specify
the same combination of username and folder.
diff --git a/Changes b/Changes
index 7195d1a..4350586 100644
--- a/Changes
+++ b/Changes
@@ -1,6 +1,8 @@
Revision history for App-wsgetmail
0.07 ??/??/??
+ * Add locking based on the config file to prevent multiple instances
+ from running on the same account/mailbox at the same time.
* Remove '+ 5' adjustment to timeout in MDA.pm
* Remove interpreter substitution for wsgetmail
diff --git a/bin/wsgetmail b/bin/wsgetmail
index 4631c32..8a43a2f 100755
--- a/bin/wsgetmail
+++ b/bin/wsgetmail
@@ -49,11 +49,11 @@
use v5.10;
use strict;
+use Fcntl ':flock';
use FindBin;
use lib "$FindBin::Bin/../lib";
use JSON;
use App::wsgetmail;
-use File::Slurp;
use Pod::Usage;
use Getopt::Long;
@@ -70,8 +70,19 @@ pod2usage(1) if $help;
pod2usage(1) unless ($config_file);
die "Can't find config file $config_file" unless (-f $config_file);
+open my $config_file_fh, '<', $config_file or die;
+
+if ( !flock $config_file_fh, LOCK_EX | LOCK_NB ) {
+ print "$0 is already running on config file $config_file ($!)\n";
+ exit;
+}
+
# parse options, over-ride config if provided extra options
-my $config_json = read_file($config_file);
+my $config_json;
+{
+ local $/ = undef;
+ $config_json = <$config_file_fh>;
+}
my $config = decode_json($config_json);
my $extra_options = (defined($options) && $options ) ? decode_json($options) : { };
foreach my $option ( keys %$extra_options ) {
commit 36ab0fcd8e667703b31491870aa5af14b207288b
Author: Brian Conry <bconry at bestpractical.com>
Date: Wed Sep 14 12:39:51 2022 -0500
Remove 5 second fudge from configured timeout
Prior to commit b56eff4 when no timeout was configured for the timeout
the value would be left undef instead of the intended default. The '+
5' both coerced the undef to a defined value and provided a long-enough
timeout for most cases, though not the full 30 seconds intended to be
the default.
Since that commit the intended default has been used and the extra time
no longer needs to be added.
This change also documents that 'inf' should be used for no timeout, as
with IPC::Run a value of '0' is treated as an immediate timeout.
diff --git a/Changes b/Changes
index 904a4f6..7195d1a 100644
--- a/Changes
+++ b/Changes
@@ -1,6 +1,7 @@
Revision history for App-wsgetmail
0.07 ??/??/??
+ * Remove '+ 5' adjustment to timeout in MDA.pm
* Remove interpreter substitution for wsgetmail
0.06 22/04/22
diff --git a/README.md b/README.md
index c7ef00d..507e03a 100644
--- a/README.md
+++ b/README.md
@@ -59,7 +59,7 @@ A hash ref that is passed to construct the `mda` and `client` (see below).
## mda
-An instance of [App::wsgetmail::MDA](https://metacpan.org/pod/App::wsgetmail::MDA) created from our `config` object.
+An instance of [App::wsgetmail::MDA](https://metacpan.org/pod/App%3A%3Awsgetmail%3A%3AMDA) created from our `config` object.
## client\_class
@@ -219,7 +219,7 @@ configuration file.
- command\_timeout
Set this to the number of seconds the `command` has to return before
- timeout is reached. The default value is 30.
+ timeout is reached. The default value is 30. Use 'inf' for no timeout.
- action\_on\_fetched
@@ -278,9 +278,9 @@ of time.
# SEE ALSO
- [wsgetmail](https://metacpan.org/pod/wsgetmail)
-- [App::wsgetmail::MDA](https://metacpan.org/pod/App::wsgetmail::MDA)
-- [App::wsgetmail::MS365](https://metacpan.org/pod/App::wsgetmail::MS365)
-- [App::wsgetmail::MS365::Message](https://metacpan.org/pod/App::wsgetmail::MS365::Message)
+- [App::wsgetmail::MDA](https://metacpan.org/pod/App%3A%3Awsgetmail%3A%3AMDA)
+- [App::wsgetmail::MS365](https://metacpan.org/pod/App%3A%3Awsgetmail%3A%3AMS365)
+- [App::wsgetmail::MS365::Message](https://metacpan.org/pod/App%3A%3Awsgetmail%3A%3AMS365%3A%3AMessage)
# AUTHOR
diff --git a/lib/App/wsgetmail.pm b/lib/App/wsgetmail.pm
index 4bb0004..5d5c75d 100644
--- a/lib/App/wsgetmail.pm
+++ b/lib/App/wsgetmail.pm
@@ -428,7 +428,7 @@ double quotes.
=item command_timeout
Set this to the number of seconds the C<command> has to return before
-timeout is reached. The default value is 30.
+timeout is reached. The default value is 30. Use 'inf' for no timeout.
=item action_on_fetched
diff --git a/lib/App/wsgetmail/MDA.pm b/lib/App/wsgetmail/MDA.pm
index eb18e47..0f46960 100644
--- a/lib/App/wsgetmail/MDA.pm
+++ b/lib/App/wsgetmail/MDA.pm
@@ -199,7 +199,7 @@ sub _run_command {
return 1;
}
- my $ok = run ([ $self->command, _split_command_args($self->command_args, 1)], $fh, \$output, \$error, timeout( $self->command_timeout + 5 ) );
+ my $ok = run ([ $self->command, _split_command_args($self->command_args, 1)], $fh, \$output, \$error, timeout( $self->command_timeout ) );
unless ($ok) {
warn sprintf('failed to run command "%s %s" for file %s : %s',
$self->command,
commit ef1166688563c07c0f7e9a15121aa56c0132ca3e
Author: Brian Conry <bconry at bestpractical.com>
Date: Wed Sep 14 10:48:53 2022 -0500
Remove shebang line substitution from bin/wsgetmail
This avoids certain possible issues when doing 'make dist' and
eliminates the possibility of unintentionally commiting a change to the
shebang line to the author's current perl path.
diff --git a/Changes b/Changes
index 6b2e719..904a4f6 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
Revision history for App-wsgetmail
+0.07 ??/??/??
+ * Remove interpreter substitution for wsgetmail
+
0.06 22/04/22
* Update 0.05 Changes to conform to spec
* Sync module pod with recent changes in script
diff --git a/Makefile.PL b/Makefile.PL
index 9e03110..224bccb 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -31,13 +31,6 @@ if ($^O ne 'VMS' and $secure_perl_path !~ /$Config{_exe}$/i) {
$secure_perl_path .= $Config{_exe};
}
-substitute(
- {
- PERL => $ENV{PERL} || $secure_perl_path,
- },
- 'bin/wsgetmail',
-);
-
install_script('bin/wsgetmail');
auto_install();
sign;
diff --git a/bin/wsgetmail b/bin/wsgetmail
index 2218417..4631c32 100755
--- a/bin/wsgetmail
+++ b/bin/wsgetmail
@@ -1,6 +1,4 @@
#!/usr/bin/env perl
-### before: #!@PERL@
-#
# BEGIN BPS TAGGED BLOCK {{{
#
# COPYRIGHT:
diff --git a/inc/Module/Install/Substitute.pm b/inc/Module/Install/Substitute.pm
deleted file mode 100644
index 56af7fe..0000000
--- a/inc/Module/Install/Substitute.pm
+++ /dev/null
@@ -1,131 +0,0 @@
-#line 1
-package Module::Install::Substitute;
-
-use strict;
-use warnings;
-use 5.008; # I don't care much about earlier versions
-
-use Module::Install::Base;
-our @ISA = qw(Module::Install::Base);
-
-our $VERSION = '0.03';
-
-require File::Temp;
-require File::Spec;
-require Cwd;
-
-#line 89
-
-sub substitute
-{
- my $self = shift;
- $self->{__subst} = shift;
- $self->{__option} = {};
- if( UNIVERSAL::isa( $_[0], 'HASH' ) ) {
- my $opts = shift;
- while( my ($k,$v) = each( %$opts ) ) {
- $self->{__option}->{ lc( $k ) } = $v || '';
- }
- }
- $self->_parse_options;
-
- my @file = @_;
- foreach my $f (@file) {
- $self->_rewrite_file( $f );
- }
-
- return;
-}
-
-sub _parse_options
-{
- my $self = shift;
- my $cwd = Cwd::getcwd();
- foreach my $t ( qw(from to) ) {
- $self->{__option}->{$t} = $cwd unless $self->{__option}->{$t};
- my $d = $self->{__option}->{$t};
- die "Couldn't read directory '$d'" unless -d $d && -r _;
- }
-}
-
-sub _rewrite_file
-{
- my ($self, $file) = @_;
- my $source = File::Spec->catfile( $self->{__option}{from}, $file );
- $source .= $self->{__option}{sufix} if $self->{__option}{sufix};
- unless( -f $source && -r _ ) {
- print STDERR "Couldn't find file '$source'\n";
- return;
- }
- my $dest = File::Spec->catfile( $self->{__option}{to}, $file );
- return $self->__rewrite_file( $source, $dest );
-}
-
-sub __rewrite_file
-{
- my ($self, $source, $dest) = @_;
-
- my $mode = (stat($source))[2];
-
- open my $sfh, "<$source" or die "Couldn't open '$source' for read";
- print "Open input '$source' file for substitution\n";
-
- my ($tmpfh, $tmpfname) = File::Temp::tempfile('mi-subst-XXXX', UNLINK => 1);
- $self->__process_streams( $sfh, $tmpfh, ($source eq $dest)? 1: 0 );
- close $sfh;
-
- seek $tmpfh, 0, 0 or die "Couldn't seek in tmp file";
-
- open my $dfh, ">$dest" or die "Couldn't open '$dest' for write";
- print "Open output '$dest' file for substitution\n";
-
- while( <$tmpfh> ) {
- print $dfh $_;
- }
- close $dfh;
- chmod $mode, $dest or "Couldn't change mode on '$dest'";
-}
-
-sub __process_streams
-{
- my ($self, $in, $out, $replace) = @_;
-
- my @queue = ();
- my $subst = $self->{'__subst'};
- my $re_subst = join('|', map {"\Q$_"} keys %{ $subst } );
-
- while( my $str = <$in> ) {
- if( $str =~ /^###\s*(before|replace|after)\:\s?(.*)$/s ) {
- my ($action, $nstr) = ($1,$2);
- $nstr =~ s/\@($re_subst)\@/$subst->{$1}/ge;
-
- die "Replace action is bad idea for situations when dest is equal to source"
- if $replace && $action eq 'replace';
- if( $action eq 'before' ) {
- die "no line before 'before' action" unless @queue;
- # overwrite prev line;
- pop @queue;
- push @queue, $nstr;
- push @queue, $str;
- } elsif( $action eq 'replace' ) {
- push @queue, $nstr;
- } elsif( $action eq 'after' ) {
- push @queue, $str;
- push @queue, $nstr;
- # skip one line;
- <$in>;
- }
- } else {
- push @queue, $str;
- }
- while( @queue > 3 ) {
- print $out shift(@queue);
- }
- }
- while( scalar @queue ) {
- print $out shift(@queue);
- }
-}
-
-1;
-
-----------------------------------------------------------------------
hooks/post-receive
--
app-wsgetmail
More information about the Bps-public-commit
mailing list