by [Reinhard Max], August 2003.

This is a little script to fetch emails from http://webmailer.t-online.de .
I wrote it, because [T-Online] charges extra money if you want POP3 access from
outside their own dialup networks.

Fortunately the webmailer allows for downloading of selected emails, and sends
the mails to be downloades in the traditional mbox format. This makes it easy to
re-gain the original emails, including all headers, and pass them on via smtp or local delivery on Unix systems.

The name is a merger of the words '''POP3''' and T-On'''line''', and '''Popeline''', the German word for poplin, because T-Online leaves you out in the rain when you want to change the access provider, but keep the email address.

----

 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 {<A HREF="([^\"]+)/main.cgp">} $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] ]]