Attachment 46044 Details for Bug 104665

choeger_ssl_perl_tk_biff

choeger_ssl_perl_tk_biff (text/plain), 5.38 KB, created by Carsten Hoeger on 2005-08-15 12:06:36 UTC

(hide)

Description:

Filename:

MIME Type:

Creator: Carsten Hoeger

Created: 2005-08-15 12:06:36 UTC

Size: 5.38 KB

patch

obsolete

>#! /usr/bin/perl -w
>#
># choegers imap_ssl biff
># WirrWare
>#
>use strict;
>use Socket;
>use FileHandle;
>
>use Tk;
>use IO::Socket::SSL;
>
>#-----------------------------------------------------------------
>#
># change values below
># 
>my $RCFILE = $ENV{'HOME'}."/.cbiffrc";
>
># do not edit below this line
>#-----------------------------------------------------------------
>
># some defaults
>my $pollinterval  = 20000;
>my $ssl           = 1;
>my $debug         = 0;
>my $msgshow       = 0;
>my $geometry      = "-0+0";
>my @dontDisplay;
>
>if( ! -e $RCFILE ) {
>    print "creating $RCFILE with some defaults\n";
>    open(OUT,">$RCFILE") || die "Unable to create initial $RCFILE!";
>    print OUT "debug = 0          # 1 or 0
>ssl = 1            # 1 or 0
>show_msg_num = 1   # 1 or 0
>poll_interval = 20 # interval in seconds
>geometry = -0+0
>#
># comma seperated list of folders without INBOX prefix
>#
>dont_display = sent-mail, postponed
>";
>    close(OUT)
>}
>
>open(CF, "<$RCFILE") || die "Uable to open configfile $RCFILE!";
>my $l;
>while(($l=<CF>)) {
>    chomp($l);
>    next if $l =~ /^\#/;
>    $l =~ s/(.*?)\#.*/$1/;
>    if( $l =~ /^debug\s*=\s*(\d+)/ ) {
>	$debug = $1;
>	print "starting in debug mode...\n" if $debug;
>	next;
>    }
>    if( $l =~ /^ssl\s*=\s*(\d+)/ ) {
>	$ssl = $1;
>	print "using SSL...\n" if $ssl;
>	next;
>    }
>    if( $l =~ /^poll_interval\s*=\s*(\d+)/ ) {
>	$pollinterval = ($1*1000);
>	next;
>    }
>    if( $l =~ /^geometry\s*=\s*([\d+-]+)/ ) {
>	$geometry = $1;
>	next;
>    }
>    if( $l =~ /^dont_display\s*=\s*(.*)/ ) {
>	@dontDisplay = split(/,\s*/,$1);
>	next;
>    }
>    if( $l =~ /^show_msg_num\s*=\s*(\d+)/ ) {
>	$msgshow = $1;
>	next;
>    }
>}
>close(CF);
>
>if( $debug ) {
>    print "Show message numbers\n" if $msgshow;
>    print "Pollinterval=<".($pollinterval/1000)."> seconds\n";
>    foreach my $d ( @dontDisplay ) {
>	print "dontDisplay folder=<$d>\n";
>    }
>}
>
>if( ! defined $ARGV[0] ) {
>    die "No hostname given!\n";
>}
>if( ! defined $ARGV[1] ) {
>    die "No username given!\n";
>}
>
>my $host          = "";
>my $user          = "";
>
>$host = $ARGV[0];
>$user = $ARGV[1];
>
>my $caddr = sockaddr_in(143, inet_aton($host));
>my $sock;
>
>
>doconnect();
>readln();
>
>my $retry = 0;
>my $ret = "";
>do {
>    my $pass = "";
>    my $w = new MainWindow(-title => "Passwort");
>    
>    my $pwf = $w->Entry(-textvariable => \$pass,
>                        -show => '*' )->pack();
>    $pwf->bind('<Return>' => sub{$w->destroy;});
>    $pwf->focus;
>    $pwf->grab;
>    $retry++;
>    
>    
>    MainLoop;
>    $ret = putln(". login $user \"$pass\"");
>} while($ret !~ /^\. OK/ && $retry < 6);
>
>mydie("$ret") if $ret =~ /\. NO/;
>
>
>my $w = new MainWindow;
>$w->geometry($geometry);
>$w->overrideredirect(1);
>
>if( $ssl && $debug ) {
>    $IO::Socket::SSL::DEBUG = 1;
>}
>
>my %buttons;
>
>my ($boxh, $boxl) = fetchBoxlist();
>foreach my $bk ( @$boxl ) {
>    my $button =
>	$w->Button(-text   => "",
>		   -relief => 'raised',
>		   -padx => 2,
>		   -pady => 2,
>		   -background => ( $boxh->{$bk}->{"new"} > 0 ?
>				    'PaleGreen' : 'DarkSlateBlue'),
>		   -foreground => ( $boxh->{$bk}->{"new"} > 0 ? 'Black' : 'PowderBlue'),
>		   -command=> [ $w => 'destroy' ] )->pack(-side=>'left');
>    $buttons{$bk} = $button;
>}
>
>update();
>MainLoop;
>
>putln(". logout");
>
>
>1;
>
>sub mydie {
>    my $txt = shift;
>
>    #my $w = new MainWindow(-title => "Passwort");
>    #$w->focusmodel('active');
>    
>    #my $pwf = $w->Entry(-textvariable => \$txt )->pack();
>    #$pwf->bind('<Return>' => sub{$w->destroy;});
>    #MainLoop;
>    print $txt;
>    exit;
>}
>
>sub skipped {
>    my $mb = shift;
>    foreach my $f ( @dontDisplay ) {
>	return 1 if "INBOX.".$f eq $mb;
>    }
>    return 0;
>}
>
>sub fetchBoxlist {
>    my $ret = putln(". list INBOX *");
>    my @rb = split(/\r\n/,$ret);
>    my $blh;
>    my $bxl;
>    foreach my $l ( @rb ) {
>	if( $l =~ /LIST/ ) {
>	    $l =~ s/.*?\"(INBOX.*)\"/$1/;
>	    my $mb = $1;
>	    next if skipped($mb);
>	    push @$bxl, $mb;
>	    print "mailbox=$mb " if $debug;
>	    my @selr = split(/\r\n/, putln(". examine $mb"));
>	    foreach my $s ( @selr ) {
>		if( $s =~ /.*\s+(\d+).*EXISTS/ ) {
>		    $blh->{$mb}->{"nr"} = $1;
>		    print "nrmsg=$1 " if $debug;
>		}
>		if( $s =~ /.*\s+(\d+).*RECENT/ ) {
>		    $blh->{$mb}->{"new"} = $1;
>		    print "nrnew=$1\n" if $debug;
>		}
>	    }
>	}
>    }
>    return ($blh, $bxl);
>}
>
>sub update {
>    my ( $boxh, $boxl ) = fetchBoxlist();
>    foreach my $bk ( @$boxl ) {
>	my $mb = $bk;
>	my $nrnew = $boxh->{$bk}->{"new"};
>	my $nr    = $boxh->{$bk}->{"nr"};
>	$mb =~ s/INBOX\.(.*)/$1/;
>	if( $msgshow ) {
>	    $mb = $mb." ($nr/$nrnew)";
>	}
>	$buttons{$bk}->configure(-text => ( $nr > 0 || $nrnew > 0
>					    ? $mb : "" ),
>				 -background => ( $boxh->{$bk}->{"new"} > 0 ?
>						  'PaleGreen' : 'DarkSlateBlue'),
>				 -foreground => ( $boxh->{$bk}->{"new"} > 0 ?
>						  'Black' : 'PowderBlue') );
>    }
>    $w->after($pollinterval, \&update);
>}
>
>sub putln {
>    my $ln = shift;
>    print $sock "$ln\r\n";
>    $sock->flush();
>    return readln();
>}
>
>sub readln {
>    my $line = "";
>    my $buf = "";
>    my $rbit = "";
>    
>    while( sysread($sock,$buf,4096) ) {
>	$line .= $buf;
>	last if $line =~ /\r\n/;
>    }
>    return $line;
>}
>
>sub doconnect {
>    if( ! $ssl ) {
>	socket($sock, PF_INET, SOCK_STREAM, getprotobyname('tcp')) || mydie "socket: $!";
>	connect($sock, $caddr) || mydie "connect: $!";
>    } else {
>	$sock = IO::Socket::SSL->new( PeerAddr => $host,
>				      PeerPort => 993,
>				      Proto    => 'tcp',
>				      SSL_verify_mode => 0x00 );
>	if( ! $sock ) {
>	    mydie "unable to create socket: $!";
>	}
>    }
>}
>
>

Actions: View

Attachments on bug 104665: 46044