[Bps-public-commit] app-wsgetmail branch branch-for-multiple-improvements created. 0.06-5-g00ab131
BPS Git Server
git at git.bestpractical.com
Tue Sep 20 22:58:05 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 00ab1310a0212ce3adf26f3497e5f666167cda37 (commit)
- Log -----------------------------------------------------------------
commit 00ab1310a0212ce3adf26f3497e5f666167cda37
Author: Brian Conry <bconry at bestpractical.com>
Date: Mon Sep 19 18:08:22 2022 -0500
Document the dump_messages option
This option was previously undocumented.
diff --git a/Changes b/Changes
index 86a39f1..9ec068b 100644
--- a/Changes
+++ b/Changes
@@ -1,6 +1,7 @@
Revision history for App-wsgetmail
0.07 ??/??/??
+ * Add documentation of the dump_messages option
* Add strip_cr option to convert CRLF -> LF
* Add locking based on the username/folder
* Remove '+ 5' adjustment to timeout in MDA.pm
diff --git a/lib/App/wsgetmail.pm b/lib/App/wsgetmail.pm
index ec71d72..a589b05 100644
--- a/lib/App/wsgetmail.pm
+++ b/lib/App/wsgetmail.pm
@@ -449,6 +449,12 @@ If you set this to C<"mark_as_read">, wsgetmail will only retrieve and
deliver messages that are marked unread in the configured folder, so it does
not try to deliver the same email multiple times.
+=item dump_messages
+
+Set this to 1 to preserve the temporary files after processing.
+
+When C<"debug"> is also set the filenames will be reported on STDERR.
+
=back
=head1 TESTING AND DEPLOYMENT
commit 8fdce697bd3ffa9c3ebf806845d03ef64cfd70f8
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 c509610..86a39f1 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 username/folder
* Remove '+ 5' adjustment to timeout in MDA.pm
* Remove interpreter substitution for wsgetmail
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 4d3335056b89c1bbdc5f796e513c78177387dd12
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 username and folder from the
merged configuration (config file + comamnd-line overrides).
This prevents multiple isntances running simultaneously on the same
username/folder while still allowing multiple instances to run, even
when they use the same base configuration.
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.
diff --git a/Changes b/Changes
index 7195d1a..c509610 100644
--- a/Changes
+++ b/Changes
@@ -1,6 +1,7 @@
Revision history for App-wsgetmail
0.07 ??/??/??
+ * Add locking based on the username/folder
* Remove '+ 5' adjustment to timeout in MDA.pm
* Remove interpreter substitution for wsgetmail
diff --git a/bin/wsgetmail b/bin/wsgetmail
index 4631c32..d680b16 100755
--- a/bin/wsgetmail
+++ b/bin/wsgetmail
@@ -49,6 +49,7 @@
use v5.10;
use strict;
+use Fcntl ':flock';
use FindBin;
use lib "$FindBin::Bin/../lib";
use JSON;
@@ -80,6 +81,18 @@ foreach my $option ( keys %$extra_options ) {
$config->{dry_run} = $dry_run if (defined $dry_run);
$config->{debug} = $debug if (defined $debug);
+my $foldername = $config->{folder};
+
+$foldername =~ s{/}{_}g;
+
+my $lock_file_name = '/tmp/' . join( '.', 'wsgetmail', $config->{username}, $foldername, 'lock' );
+
+open my $lock_file_fh, '>', $lock_file_name or die;
+
+if ( !flock $lock_file_fh, LOCK_EX | LOCK_NB ) {
+ print "$0 is already running for $config->{username}/$config->{folder} ($!)\n";
+ exit;
+}
my $getmail = App::wsgetmail->new({config => $config});
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