by [Reinhard Max], August 2003. This is a little script to fetch emails from [T-Online]'s web mailer [http://webmailer.t-online.de]. I wrote it, because [T-Online] charges (too much) extra money for real [POP3] access from outside their own dialup networks. The name is a merger of the three words '''POP3''' (although it doesn't actually talk POP3), T-On'''line''', and '''Popeline''', the German word for poplin. I chose it because T-Online leaves you out in the rain when you want to move on to another access provider, but keep your email address. Coincidentally the german C't magazine recently showed a Perl solution for the same problem: [http://www.heise.de/ct/03/15/158/default.shtml]. Fortunately the webmailer allows for downloading of selected emails in the traditional mbox format. This makes it easy to re-gain the original emails, including all the header fields, and pass them on via smtp or local delivery on Unix systems. To use it on Windows, you can either add support for storing the configuration in the registry, or simply set the variables at the beginning of the script instead of trying to source the config file. ---- set config ~/.pop3line if {[file exists $config]} { source $config } else { set fd [open $config w] file attributes $config -permissions 0600 puts $fd "# Die T-Online E-Mail Adresse, von der die Mails geholt werden." puts $fd "set login {@t-online.de}" puts $fd "" puts $fd "# Das Pawort fr den T-Online Webmailer." puts $fd "set password {mysecret}" puts $fd "" puts $fd "Der SMTP-Server, ber den die Mails weitergeschickt werden." puts $fd "set smtpserver localhost" puts $fd "" puts $fd "# Der lokale Benutzer, an den die Mails weitergeschickt werden." puts $fd "set recipient $tcl_platform(user)@$smtpserver" puts $fd "" puts $fd "# Sollen die Emails nach dem Abholen" puts $fd "# gelscht werden (1) oder nicht (0)?" puts $fd "set delete 1" close $fd puts "Created configuration file: $config ." puts "Please edit and run me again." exit 1 } package require http package require tls package require mime package require smtp http::register https 443 ::tls::socket proc sendMails data { set next -1 puts -nonewline stderr "Sending emails " while 42 { set start [string first \n $data [expr {$next + 1}]] incr start set next [string first "\nFrom " $data $start] set end [expr {($next == -1) ? "end" : ($next - 1)}] set mail [string range $data $start $end] set T [mime::initialize -string $mail] set cmd [list smtp::sendmessage $T -queue 1 \ -servers $::smtpserver -recipients $::recipient] foreach {key value} [mime::getheader $T] { mime::setheader $T $key "" -mode delete foreach item $value { lappend cmd -header [list $key $item] } } eval $cmd mime::finalize $T puts -nonewline stderr . if {$next == -1} break } puts stderr "" } proc main {} { set error 0 set BASE https://webmail.t-online.de # login and redirect set token [http::geturl $BASE] set data [http::data $token] http::cleanup $token regexp {name="sessionid" value="([^\"]*)">} $data -> id set query [http::formatQuery js 0 sessionid $id ${id}log1n $::login \ ${id}passw8rd $::password] # message overview set token [http::geturl $BASE/main.cgp -query $query] set data [http::data $token] http::cleanup $token # Redefine BASE according to the current session regexp {} $data -> BASE # find the emails set RE {name="(MAIL[^\"]*)" value="([^\"]*)">} set query "" while 42 { set token [http::geturl $BASE/main.cgp -query $query] set data [http::data $token] http::cleanup $token set mails [list] foreach {_ name value} [regexp -all -inline $RE $data] { lappend mails $name $value } set count [expr {[llength $mails]/2}] if {$count} { puts stderr "Downloading $count mail(s)." } else { puts stderr "No (more) mails to download!" break } set query [eval http::formatQuery Speichern.x 1 $mails] set token [http::geturl $BASE/mailfolder.txt -query $query] array set meta [set ${token}(meta)] set http [set ${token}(http)] set ncode [http::ncode $token] set data [http::data $token] http::cleanup $token if {$ncode == 200 && $meta(Content-Type) eq "x-download/rfc822"} { sendMails $data if {$::delete} { lappend mails Loeschen.x 1 set query [eval [linsert $mails 0 http::formatQuery]] } else break } else { puts stderr "$http" set error 1 break } } exit $error } main ---- [[ [Web Scraping] | [Category Internet] ]]