Net-Gmail-IMAP-Label-0.007000755001750001750 012106016443 14112 5ustar00zakizaki000000000000README100644001750001750 46112106016443 15034 0ustar00zakizaki000000000000Net-Gmail-IMAP-Label-0.007 This archive contains the distribution Net-Gmail-IMAP-Label, version 0.007: IMAP proxy for Google's Gmail that retrieves message labels This software is Copyright (c) 2011 by Zakariyya Mughal . This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) Changes100644001750001750 122512106016443 15466 0ustar00zakizaki000000000000Net-Gmail-IMAP-Label-0.0070.007 2013-02-10 16:17:52-0600 - add metadata to distribution - improve documentation 0.006 2012-12-12 12:46:35-0600 - minimum version for Capture::Tiny 0.005 2012-12-08 15:18:49-0600 - more correct regex quantifier 0.004 2012-12-08 15:18:49-0600 - fix documentation - change IMAP response matching to handle quoting of labels (specifically for parentheses) 0.003 2012-12-07 11:12:21-0600 - add dzil plugin to check changelog 0.002 2012-12-07 11:05:47-0600 - change dzil license to Artistic 2.0 0.001 2012-12-07 04:03:08-0600 - change to module distribution - add command-line options - add tests for request/response filter map LICENSE100644001750001750 150012106016443 15174 0ustar00zakizaki000000000000Net-Gmail-IMAP-Label-0.007This software is made available under the ISC license: Copyright (c) 2011, Zakariyya Mughal Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies. THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. --- Or the Artistic License version 2. dist.ini100644001750001750 52512106016443 15621 0ustar00zakizaki000000000000Net-Gmail-IMAP-Label-0.007name = Net-Gmail-IMAP-Label author = Zakariyya Mughal license = Artistic_2_0 copyright_holder = Zakariyya Mughal copyright_year = 2011 version = 0.007 [@Filter] -bundle = @Basic -remove = License [AutoPrereqs] [PkgVersion] [CheckChangeLog] [GithubMeta] [Prereqs / TestRequires] Capture::Tiny = 0.12 META.yml100644001750001750 164412106016443 15451 0ustar00zakizaki000000000000Net-Gmail-IMAP-Label-0.007--- abstract: "IMAP proxy for Google's Gmail that retrieves message labels" author: - 'Zakariyya Mughal ' build_requires: Capture::Tiny: 0.12 Test::More: 0 utf8: 0 configure_requires: ExtUtils::MakeMaker: 6.30 dynamic_config: 0 generated_by: 'Dist::Zilla version 4.300028, CPAN::Meta::Converter version 2.120921' license: artistic_2 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Net-Gmail-IMAP-Label requires: Carp: 0 Encode: 0 Encode::IMAPUTF7: 0 FindBin: 0 Getopt::Long::Descriptive: 0 POE: 0 POE::Component::Client::TCP: 0 POE::Component::SSLify: 0 POE::Component::Server::TCP: 0 POE::Filter::Map: 0 POE::Filter::Stackable: 0 Regexp::Common: 0 constant: 0 strict: 0 warnings: 0 resources: homepage: https://github.com/zmughal/gmail-imap-label repository: https://github.com/zmughal/gmail-imap-label.git version: 0.007 MANIFEST100644001750001750 41512106016443 15304 0ustar00zakizaki000000000000Net-Gmail-IMAP-Label-0.007Changes LICENSE MANIFEST META.yml Makefile.PL README README.markdown bin/gmail-imap-label dist.ini doc/example.muttrc doc/example.offlineimaprc lib/Net/Gmail/IMAP/Label.pm lib/Net/Gmail/IMAP/Label/Proxy.pm t/00_packages.t t/00_usage.t t/01_get_label.t t/02_put_label.t Makefile.PL100644001750001750 276712106016443 16161 0ustar00zakizaki000000000000Net-Gmail-IMAP-Label-0.007 use strict; use warnings; use ExtUtils::MakeMaker 6.30; my %WriteMakefileArgs = ( "ABSTRACT" => "IMAP proxy for Google's Gmail that retrieves message labels", "AUTHOR" => "Zakariyya Mughal ", "BUILD_REQUIRES" => { "Capture::Tiny" => "0.12", "Test::More" => 0, "utf8" => 0 }, "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => "6.30" }, "DISTNAME" => "Net-Gmail-IMAP-Label", "EXE_FILES" => [ "bin/gmail-imap-label" ], "LICENSE" => "artistic_2", "NAME" => "Net::Gmail::IMAP::Label", "PREREQ_PM" => { "Carp" => 0, "Encode" => 0, "Encode::IMAPUTF7" => 0, "FindBin" => 0, "Getopt::Long::Descriptive" => 0, "POE" => 0, "POE::Component::Client::TCP" => 0, "POE::Component::SSLify" => 0, "POE::Component::Server::TCP" => 0, "POE::Filter::Map" => 0, "POE::Filter::Stackable" => 0, "Regexp::Common" => 0, "constant" => 0, "strict" => 0, "warnings" => 0 }, "VERSION" => "0.007", "test" => { "TESTS" => "t/*.t" } ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.56) } ) { my $br = delete $WriteMakefileArgs{BUILD_REQUIRES}; my $pp = $WriteMakefileArgs{PREREQ_PM}; for my $mod ( keys %$br ) { if ( exists $pp->{$mod} ) { $pp->{$mod} = $br->{$mod} if $br->{$mod} > $pp->{$mod}; } else { $pp->{$mod} = $br->{$mod}; } } } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); t000755001750001750 012106016443 14276 5ustar00zakizaki000000000000Net-Gmail-IMAP-Label-0.00700_usage.t100644001750001750 66012106016443 16210 0ustar00zakizaki000000000000Net-Gmail-IMAP-Label-0.007/t#!/usr/bin/perl use Test::More; use Capture::Tiny qw/capture_stdout/; BEGIN { use_ok( 'Net::Gmail::IMAP::Label' ); } require_ok( 'Net::Gmail::IMAP::Label' ); # test --help @ARGV = qw/-h/; my $usage_msg = capture_stdout { Net::Gmail::IMAP::Label->run }; like($usage_msg, qr/--help/, 'has --help option'); like($usage_msg, qr/--port/, 'has --port option'); like($usage_msg, qr/--verbose/, 'has --verbose option'); done_testing; README.markdown100644001750001750 216512106016443 16700 0ustar00zakizaki000000000000Net-Gmail-IMAP-Label-0.007gmail-imap-label # Description Proxy that sits between an IMAP client and Gmail's IMAPS server and adds GMail labels to the X-Label header. Tested with mutt (v1.5.21) and offlineimap (v6.3.4). # Usage By default, the proxy starts on port 10143, however another port can be specified via a command-line option. To use the proxy you will need to set up your e-mail reader to connect to that port using the IMAP protocol (without SSL). # Runtime dependencies * GMail account * Perl (tested with 5.12.4, but should work with 5.10) * POE * POE::Component::SSLify * Regexp::Common * Encode::IMAPUTF7 * Getopt::Long::Descriptive For Debian: ``` apt-get install libpoe-component-sslify-perl libregexp-common-perl libencode-imaputf7-perl libgetopt-long-descriptive-perl ``` # See also * [Git repository](https://github.com/zmughal/gmail-imap-label) * [CPAN module](http://p3rl.org/Net::Gmail::IMAP::Label) # ACK Thanks to Paul DeCarlo for pointing out the Gmail IMAP extensions that made this a whole lot easier than what I had originally planned on doing. 00_packages.t100644001750001750 36012106016443 16657 0ustar00zakizaki000000000000Net-Gmail-IMAP-Label-0.007/t#!/usr/bin/perl use Test::More; BEGIN { use_ok( 'Net::Gmail::IMAP::Label' ); } require_ok( 'Net::Gmail::IMAP::Label' ); BEGIN { use_ok( 'Net::Gmail::IMAP::Label::Proxy' ); } require_ok( 'Net::Gmail::IMAP::Label::Proxy' ); done_testing; 01_get_label.t100644001750001750 175512106016443 17051 0ustar00zakizaki000000000000Net-Gmail-IMAP-Label-0.007/t#!/usr/bin/perl use Test::More; BEGIN { use_ok( 'Net::Gmail::IMAP::Label::Proxy' ); } require_ok( 'Net::Gmail::IMAP::Label::Proxy' ); my $data = { 'a0006 FETCH 1:301 (UID FLAGS INTERNALDATE RFC822.SIZE BODY.PEEK[HEADER.FIELDS (DATE FROM SUBJECT TO CC MESSAGE-ID REFERENCES CONTENT-TYPE CONTENT-DESCRIPTION IN-REPLY-TO REPLY-TO LINES LIST-POST X-LABEL)])' => 'a0006 FETCH 1:301 (UID FLAGS INTERNALDATE RFC822.SIZE BODY.PEEK[HEADER.FIELDS (DATE FROM SUBJECT TO CC MESSAGE-ID REFERENCES CONTENT-TYPE CONTENT-DESCRIPTION IN-REPLY-TO REPLY-TO LINES LIST-POST X-LABEL)] X-GM-LABELS)', 'a0054 UID FETCH 39468 (BODY.PEEK[])' => 'a0054 UID FETCH 39468 (BODY.PEEK[] X-GM-LABELS)', 'a0054 UID FETCH 39468 BODY.PEEK[]' => 'a0054 UID FETCH 39468 (BODY.PEEK[] X-GM-LABELS)' => 'a0054 INVALID COMMAND' => 'a0054 INVALID COMMAND', }; while (($key, $value) = each %$data) { subtest 'get_label transform' => sub { is(Net::Gmail::IMAP::Label::Proxy::get_label($key), $value, 'correct fetch'); }; } done_testing; 02_put_label.t100644001750001750 1235012106016443 17114 0ustar00zakizaki000000000000Net-Gmail-IMAP-Label-0.007/t#!/usr/bin/perl use Test::More; use utf8; BEGIN { use_ok( 'Net::Gmail::IMAP::Label::Proxy' ); } require_ok( 'Net::Gmail::IMAP::Label::Proxy' ); my $data = { q/* 1 FETCH (X-GM-LABELS ("\\\\Important" "multi word" "\\\\Starred" "complex label") UID 33126 RFC822.SIZE 3936 INTERNALDATE "02-Aug-2012 14:02:53 +0000" FLAGS (\Answered Old \Flagged \Seen) BODY[HEADER.FIELDS (DATE FROM SUBJECT TO CC MESSAGE-ID REFERENCES CONTENT-TYPE CONTENT-DESCRIPTION IN-REPLY-TO REPLY-TO LINES LIST-POST X-LABEL)] {405}/ => q/* 1 FETCH (UID 33126 RFC822.SIZE 3936 INTERNALDATE "02-Aug-2012 14:02:53 +0000" FLAGS (\Answered Old \Flagged \Seen) BODY[HEADER.FIELDS (DATE FROM SUBJECT TO CC MESSAGE-ID REFERENCES CONTENT-TYPE CONTENT-DESCRIPTION IN-REPLY-TO REPLY-TO LINES LIST-POST X-LABEL)] {444}/. Net::Gmail::IMAP::Label::Proxy::LINESEP. q/X-Label: "multi word" "complex label"/, q/* 296 FETCH (X-GM-LABELS (simple) UID 39461 RFC822.SIZE 8129 INTERNALDATE "07-Dec-2012 04:15:03 +0000" FLAGS (\Seen) BODY[HEADER.FIELDS (DATE FROM SUBJECT TO CC MESSAGE-ID REFERENCES CONTENT-TYPE CONTENT-DESCRIPTION IN-REPLY-TO REPLY-TO LINES LIST-POST X-LABEL)] {462}/ => q/* 296 FETCH (UID 39461 RFC822.SIZE 8129 INTERNALDATE "07-Dec-2012 04:15:03 +0000" FLAGS (\Seen) BODY[HEADER.FIELDS (DATE FROM SUBJECT TO CC MESSAGE-ID REFERENCES CONTENT-TYPE CONTENT-DESCRIPTION IN-REPLY-TO REPLY-TO LINES LIST-POST X-LABEL)] {479}/. Net::Gmail::IMAP::Label::Proxy::LINESEP. q/X-Label: simple/, q/* 299 FETCH (X-GM-LABELS (simple) UID 39466 BODY[] {10572}/ => q/* 299 FETCH (UID 39466 BODY[] {10589}/. Net::Gmail::IMAP::Label::Proxy::LINESEP. q/X-Label: simple/, q/* 213 FETCH (X-GM-LABELS ("\\\\Important") UID 38141 RFC822.SIZE 18747 INTERNALDATE "13-Nov-2012 15:54:38 +0000" FLAGS (Old \Seen) BODY[HEADER.FIELDS (DATE FROM SUBJECT TO CC MESSAGE-ID REFERENCES CONTENT-TYPE CONTENT-DESCRIPTION IN-REPLY-TO REPLY-TO LINES LIST-POST X-LABEL)] {421}/ => q/* 213 FETCH (UID 38141 RFC822.SIZE 18747 INTERNALDATE "13-Nov-2012 15:54:38 +0000" FLAGS (Old \Seen) BODY[HEADER.FIELDS (DATE FROM SUBJECT TO CC MESSAGE-ID REFERENCES CONTENT-TYPE CONTENT-DESCRIPTION IN-REPLY-TO REPLY-TO LINES LIST-POST X-LABEL)] {421}/, q/* 213 FETCH (X-GM-LABELS ("\\\\Important" "\\\\Starred") UID 38141 RFC822.SIZE 18747 INTERNALDATE "13-Nov-2012 15:54:38 +0000" FLAGS (Old \Seen) BODY[HEADER.FIELDS (DATE FROM SUBJECT TO CC MESSAGE-ID REFERENCES CONTENT-TYPE CONTENT-DESCRIPTION IN-REPLY-TO REPLY-TO LINES LIST-POST X-LABEL)] {421}/ => q/* 213 FETCH (UID 38141 RFC822.SIZE 18747 INTERNALDATE "13-Nov-2012 15:54:38 +0000" FLAGS (Old \Seen) BODY[HEADER.FIELDS (DATE FROM SUBJECT TO CC MESSAGE-ID REFERENCES CONTENT-TYPE CONTENT-DESCRIPTION IN-REPLY-TO REPLY-TO LINES LIST-POST X-LABEL)] {421}/, q/* 2093 FETCH (X-GM-LABELS ("\\\\Important" "multi words" "&,wglbwCwJaEAsP8JJW,+NQ- &JTslASU7-" "\\\\Starred") UID 2093 BODY[] {28208}/ => q/* 2093 FETCH (UID 2093 BODY[] {28267}/. Net::Gmail::IMAP::Label::Proxy::LINESEP. q/X-Label: "multi words" "（╯°□°）╯︵ ┻━┻"/, q/* 3928 FETCH (X-GM-LABELS ("its &- it's") UID 3928 RFC822.SIZE 409403 INTERNALDATE "22-Jun-2012 20:10:05 +0000" FLAGS (Old \Seen) BODY[HEADER.FIELDS (DATE FROM SUBJECT TO CC MESSAGE-ID REFERENCES CONTENT-TYPE CONTENT-DESCRIPTION IN-REPLY-TO REPLY-TO LINES LIST-POST X-LABEL)] {486}/ => q/* 3928 FETCH (UID 3928 RFC822.SIZE 409403 INTERNALDATE "22-Jun-2012 20:10:05 +0000" FLAGS (Old \Seen) BODY[HEADER.FIELDS (DATE FROM SUBJECT TO CC MESSAGE-ID REFERENCES CONTENT-TYPE CONTENT-DESCRIPTION IN-REPLY-TO REPLY-TO LINES LIST-POST X-LABEL)] {509}/. Net::Gmail::IMAP::Label::Proxy::LINESEP. q/X-Label: "its & it's"/, q/* 537 FETCH (X-GM-LABELS ("parens ()") UID 1471 BODY[] {873}/ => q/* 537 FETCH (UID 1471 BODY[] {895}/. Net::Gmail::IMAP::Label::Proxy::LINESEP. q/X-Label: "parens ()"/, q/* 14496 FETCH (X-GM-LABELS ("\\\\Sent" "(" "()") UID 25337 BODY[] {650}/ => q/* 14496 FETCH (UID 25337 BODY[] {669}/. Net::Gmail::IMAP::Label::Proxy::LINESEP. q/X-Label: "(" "()"/, q/* 537 FETCH (X-GM-LABELS ("zzzz\"" "\\\\Sent" "zzz)" "zz(") UID 1471 BODY[] {873}/ => q/* 537 FETCH (UID 1471 BODY[] {905}/. Net::Gmail::IMAP::Label::Proxy::LINESEP. q/X-Label: "zzzz\"" "zzz)" "zz("/, q/* 138 FETCH (X-GM-LABELS ("\\\\Important" "\\\\Sent" "\\\\") UID 36833 BODY[] {841}/ => q/* 138 FETCH (UID 36833 BODY[] {856}/. Net::Gmail::IMAP::Label::Proxy::LINESEP. q/X-Label: "\\\\"/, q/* 286 FETCH (X-GM-LABELS (Test ")") UID 39560 BODY[] {44795}/ => q/* 286 FETCH (UID 39560 BODY[] {44814}/. Net::Gmail::IMAP::Label::Proxy::LINESEP. q/X-Label: Test ")"/, q/* 283 FETCH (X-GM-LABELS (&- Test) UID 39557 BODY[] {10730}/ => q/* 283 FETCH (UID 39557 BODY[] {10747}/. Net::Gmail::IMAP::Label::Proxy::LINESEP. q/X-Label: & Test/, q/* 286 FETCH (X-GM-LABELS () UID 39560 BODY[] {44795}/ => # empty labels should not generate X-Label q/* 286 FETCH (UID 39560 BODY[] {44795}/, '* 3928 NOT A RESPONSE' => '* 3928 NOT A RESPONSE', # Not a FETCH q/* 286 FETCH (X-GM-LABELS (Broken ")""") UID 39560 BODY[] {44795}/ => # this will not parse because two strings can not be adjacent q/* 286 FETCH (X-GM-LABELS (Broken ")""") UID 39560 BODY[] {44795}/, }; while (($key, $value) = each %$data) { subtest 'put_label transform' => sub { is(Net::Gmail::IMAP::Label::Proxy::put_label($key), $value, 'correct response'); }; } done_testing; doc000755001750001750 012106016443 14600 5ustar00zakizaki000000000000Net-Gmail-IMAP-Label-0.007example.muttrc100644001750001750 74612106016443 17622 0ustar00zakizaki000000000000Net-Gmail-IMAP-Label-0.007/doc# Copy this to ~/.muttrc and edit set folder = "imap://localhost:10143" # LOCALPORT in gmail-imap-label set spoolfile = "+INBOX" set postponed="+[Gmail]/Drafts" set imap_user = "user@gmail.com" set imap_pass = "password" set smtp_url = "smtp://user@smtp.gmail.com:587/" set smtp_pass = "password" # show labels in index view: %y, %Y set index_format="%4C %Z %3N %{%b %d} %-15.15L (%?M?[%2M]&%4c?) %?y?{%-10.10y} ?%s" # show labels in message view unignore X-Label # vim: ft=muttrc bin000755001750001750 012106016443 14603 5ustar00zakizaki000000000000Net-Gmail-IMAP-Label-0.007gmail-imap-label100755001750001750 161212106016443 17763 0ustar00zakizaki000000000000Net-Gmail-IMAP-Label-0.007/bin#!/usr/bin/env perl use strict; use warnings; use FindBin qw($Bin); use lib "$Bin/../lib"; use Net::Gmail::IMAP::Label 'run'; __END__ =head1 NAME gmail-imap-label - IMAP proxy for Google's Gmail that retrieves message labels =head1 SYNOPSIS gmail-imap-label [-?hpv] [long options...] -p --port local port to connect to (default: 10143) -v --verbose increase verbosity (multiple flags for more verbosity) -? -h --help print usage message and exit =head1 OPTIONS =over 8 =item B<-p I>, B<--port I> Set the local port for the IMAP proxy. The default port is 10143. =item B<-v>, B<--verbose> Set the verbosity level. Multiple flags increase the verbosity level (e.g. -v, -vv, -vvv). =item B<-h>, B<-?>, B<--help> Print a brief help message and exits. =back =head1 SEE ALSO Description of proxy available in L =cut example.offlineimaprc100644001750001750 53412106016443 21115 0ustar00zakizaki000000000000Net-Gmail-IMAP-Label-0.007/doc# Copy this to ~/.offlineimaprc and edit [general] accounts = Gmail [Account Gmail] localrepository = GmailBox remoterepository = GmailProxy [Repository GmailBox] type = Maildir localfolders = ~/Gmail [Repository GmailProxy] type = IMAP remotehost = localhost remoteport = 10143 # from LOCALPORT in gmail-imap-label remoteuser = user@gmail.com IMAP000755001750001750 012106016443 17106 5ustar00zakizaki000000000000Net-Gmail-IMAP-Label-0.007/lib/Net/GmailLabel.pm100644001750001750 442012106016443 20623 0ustar00zakizaki000000000000Net-Gmail-IMAP-Label-0.007/lib/Net/Gmail/IMAPpackage Net::Gmail::IMAP::Label; { $Net::Gmail::IMAP::Label::VERSION = '0.007'; } use strict; use warnings; use Net::Gmail::IMAP::Label::Proxy; use Getopt::Long::Descriptive; sub import { my ($class, @opts) = @_; return unless (@opts == 1 && $opts[0] eq 'run'); $class->run; } sub run { my ($opts, $usage) = describe_options( "$0 %o", [ 'port|p=i', "local port to connect to (default: @{[Net::Gmail::IMAP::Label::Proxy::DEFAULT_LOCALPORT]})", { default => Net::Gmail::IMAP::Label::Proxy::DEFAULT_LOCALPORT } ], [ 'verbose|v+', "increase verbosity (multiple flags for more verbosity)" , { default => 0 } ], [ 'help|h|?', "print usage message and exit" ], ); if($opts->help) { print($usage->text); return 1; } Net::Gmail::IMAP::Label::Proxy->new(localport => $opts->port, verbose => $opts->verbose)->run(); } 1; =head1 NAME Net::Gmail::IMAP::Label - IMAP proxy for Google's Gmail that retrieves message labels =head1 SYNOPSIS gmail-imap-label [OPTION]... =head1 DESCRIPTION This module provides a proxy that sits between an IMAP client and Gmail's IMAPS server and adds GMail labels to the X-Label header. This proxy uses the L. To use this proxy, your e-mail client will need to connect to the proxy using the IMAP protocol (without SSL). =head1 EXAMPLES The simplest way of starting is to run the proxy on the default port of 10143: gmail-imap-label An alternative port can be specified using the B<--port> option gmail-imap-label --port 993 The proxy has been tested with both mutt (v1.5.21) and offlineimap (v6.3.4). Example configuration files for these are available in the C directory. =head1 SEE ALSO See L for a complete listing of options. =head1 BUGS Report bugs and submit patches to the repository on L. =head1 COPYRIGHT Copyright 2011 Zakariyya Mughal. This program is free software; you can redistribute it and/or modify it under the terms of either: =over 4 =item * the ISC license, or =item * the Artistic License version 2.0. =back =head1 ACKNOWLEDGMENTS Thanks to L for pointing out the Gmail IMAP extensions. =cut # vim:ts=4:sw=4 Label000755001750001750 012106016443 20125 5ustar00zakizaki000000000000Net-Gmail-IMAP-Label-0.007/lib/Net/Gmail/IMAPProxy.pm100644001750001750 1310212106016443 21761 0ustar00zakizaki000000000000Net-Gmail-IMAP-Label-0.007/lib/Net/Gmail/IMAP/Labelpackage Net::Gmail::IMAP::Label::Proxy; { $Net::Gmail::IMAP::Label::Proxy::VERSION = '0.007'; } use warnings; use strict; use POE qw(Component::Server::TCP Component::Client::TCP Filter::Stackable Filter::Map); use POE::Component::SSLify qw( Client_SSLify ); use Regexp::Common; use Encode::IMAPUTF7; use Encode qw/decode encode_utf8/; use Carp; use constant DEFAULT_LOCALPORT => 10143; use constant LINESEP => "\x0D\x0A"; use constant GMAIL_HOST => 'imap.gmail.com'; use constant GMAIL_PORT => 993; # IMAPS port # options # * localport : (0..65535) - port to start local side of proxy # * verbose : (0..4) - logging level sub new { my $class = shift; ref($class) and croak "class name needed"; my %opts = @_; my $self = {}; bless $self, $class; $self->{verbose} = $opts{verbose} // 0; $self->{localport} = $opts{localport} // DEFAULT_LOCALPORT; $self; } sub run { my ($self) = @_; $self->init() unless $self->{_init}; $self->{verbose} and carp 'running'; $poe_kernel->run(); } # Spawn the forwarder server on port given in by localport option. When new # connections arrive, spawn clients to connect them to their destination. sub init { my ($self) = @_; POE::Component::Server::TCP->new( Port => $self->{localport}, ClientConnected => sub { my ($heap, $session) = @_[HEAP, SESSION]; $self->{verbose} > 0 and logevent('server got connection', $session); $heap->{client_id} = $self->spawn_client_side(); }, ClientFilter => POE::Filter::Stackable->new( Filters => [ POE::Filter::Line->new( Literal => LINESEP), POE::Filter::Map->new( Get => \&get_label, Put => \&put_label ), ]), ClientInput => sub { my ($kernel, $session, $heap, $input) = @_[KERNEL, SESSION, HEAP, ARG0]; $self->{verbose} > 2 and logevent('server got input', $session, $self->{verbose} > 3 ? $input : undef); $kernel->post($heap->{client_id} => send_stuff => $input); }, ClientDisconnected => sub { my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP]; $self->{verbose} > 0 and logevent('server got disconnect', $session); $kernel->post($heap->{client_id} => "shutdown"); }, InlineStates => { send_stuff => sub { my ($heap, $stuff) = @_[HEAP, ARG0]; $self->{verbose} > 2 and logevent("sending to server", $_[SESSION], $self->{verbose} > 3 ? $stuff : undef ); eval { $heap->{client}->put($stuff); }; }, }, ); $self->{_init} = 1; # set init flag } sub spawn_client_side { my ($self) = @_; POE::Component::Client::TCP->new( RemoteAddress => GMAIL_HOST, PreConnect => sub { # Convert the socket into an SSL socket. my $socket = eval { Client_SSLify($_[ARG0]) }; return if $@; # Disconnect if SSL failed. return $socket; }, RemotePort => GMAIL_PORT, # IMAPS port Filter => POE::Filter::Line->new( Literal => LINESEP), Started => sub { $_[HEAP]->{server_id} = $_[SENDER]->ID; }, Connected => sub { my ($heap, $session) = @_[HEAP, SESSION]; $self->{verbose} > 0 and logevent('client connected', $session); eval { $heap->{server}->put(''); }; }, ServerInput => sub { my ($kernel, $heap, $session, $input) = @_[KERNEL, HEAP, SESSION, ARG0]; $self->{verbose} > 1 and logevent('client got input', $session, $self->{verbose} > 2 ? $input : undef); # TODO: check capabilities? $kernel->post($heap->{server_id} => send_stuff => $input); }, Disconnected => sub { my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION]; $self->{verbose} > 0 and logevent('client disconnected', $session); $kernel->post($heap->{server_id} => 'shutdown'); }, ConnectError => sub { my ($operation, $error_number, $error_string) = @_[ARG0..ARG2]; my $id = $_[SESSION]->ID; print STDERR "Client $id: $operation error $error_number occurred: $error_string\n"; $_[KERNEL]->post($_[HEAP]->{server_id} => 'shutdown'); }, InlineStates => { send_stuff => sub { my ($heap, $stuff) = @_[HEAP, ARG0]; $self->{verbose} > 2 and logevent("sending to client", $_[SESSION], $self->{verbose} > 3 ? $stuff : undef); eval { $heap->{server}->put($stuff); }; }, }, ); } sub logevent { my ($state, $session, $arg) = @_; my $id = $session->ID(); print "session $id $state "; print ": $arg" if (defined $arg); print "\n"; } sub get_label { my $data = shift; if($data =~ /^\w+ FETCH/) { $data =~ s,(BODY\.PEEK\[[^\]]*\]),$1 X-GM-LABELS,; } elsif($data =~ /^\w+ UID FETCH (\d+) \(?BODY.PEEK\[\]\)?$/) { $data =~ s,\(?(BODY.PEEK\[\])\)?,($1 X-GM-LABELS),; } return $data; } sub put_label { my $data = shift; my $fetch_re = qr/^\* \d+ FETCH.*{\d+}$/; my $label_re = qr/(?:[^() "]+)|$RE{delimited}{-delim=>'"'}/; my $fetch_gm_label = qr/^(\* \d+ FETCH.*)(X-GM-LABELS \((?:(?:$label_re\s+)*$label_re)?\) ?)(.*){(\d+)}$/; if( $data =~ $fetch_gm_label ) { my $octets = $4; my $new_fetch = "$1$3"; #print "$new_fetch\n"; (my $x_label = $2) =~ /\((.*)\)/; $x_label = $1; $x_label =~ s,"\\\\Important"\s*,,; $x_label =~ s,"\\\\Sent"\s*,,; $x_label =~ s,"\\\\Starred"\s*,,; $x_label =~ s,"\\\\Inbox",INBOX,; $x_label =~ s,^\s+,,; $x_label =~ s,\s+$,,; # trim # Gmail sends IMAP's modified UTF-7, # need to convert to UTF-8 to satisfy # in mutt $x_label = decode('IMAP-UTF-7', $x_label); if(length($x_label) > 0) { $x_label = "X-Label: $x_label"; #print "$x_label\n"; $octets += length(encode_utf8($x_label))+length(LINESEP); # 2 more for line separator $new_fetch .= "{$octets}"; $new_fetch .= LINESEP; $new_fetch .= $x_label; } else { $new_fetch .= "{$octets}"; } return $new_fetch; } return $data; } 1; # vim:ts=4:sw=4