Bugzilla – Attachment 46044 Details for
Bug 104665
perl-ssl does not seem to work anymore
Home
|
New
|
Browse
|
Search
|
[?]
|
Reports
|
Requests
|
IDP Log In
|
Forgot Password
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:
choeger_ssl_perl_tk_biff
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: $!"; > } > } >} > >
You cannot view the attachment while viewing its details because your browser does not support IFRAMEs.
View the attachment on a separate page
.
Actions:
View
Attachments on
bug 104665
: 46044