diff --git a/bfg.tcl b/bfg.tcl index e0ca2c6..704c665 100755 --- a/bfg.tcl +++ b/bfg.tcl @@ -121,6 +121,10 @@ foreach fid {widget entry status text mono} { set bfg_history "" set bfg_histidx 0 +# redirection variables for Spartan and Gemini +set redirectcount 0 +set redirectlimit 5 + # truncate status characters proc trunc {s} { set mlen 60 @@ -336,7 +340,7 @@ proc linkinsert {textw prevurl rooturl url name iprefix tag} { set url [string cat "$lscheme" ":" "$url"] } elseif {[string match "/*" "$url"]} { set url [string cat "$rooturl" "$url"] - } elseif {[string match {*/*.???} "$prevurl"]} { + } elseif {[regexp {.*/[^/]+$} "$prevurl"]} { set url [string cat "$prevurl" "/../" "$url"] } else { set url [string cat "$prevurl" "/" "$url"] @@ -439,14 +443,8 @@ proc urlfetch {inputurl refhist} { set path [dict get $parts path] set rooturl "$scheme://$host:$port" urldl $inputurl 0 - set bfg_status [trunc "Rendering $inputurl..."] - .content.text configure -state normal - .content.text delete 1.0 end; # clear the previous contents - $handler "$inputurl" "$rooturl" "$path" "$bfg_response" .content.text - .content.text configure -state disabled # append to the history if {$refhist eq 1} {histappend $inputurl} - # finalize if {$linkcount > 0} {linkfocus 0 1; set curlink 0} set targeturl $inputurl wm title . [string cat "BFG - " [trunc $targeturl]] @@ -458,6 +456,11 @@ proc urlfetch {inputurl refhist} { set bookmarkactive "\u2606" set bookmarklabel "Add bookmark" } + set bfg_status [trunc "Rendering $inputurl..."] + .content.text configure -state normal + .content.text delete 1.0 end; # clear the previous contents + $handler "$inputurl" "$rooturl" "$path" "$bfg_response" .content.text + .content.text configure -state disabled refreshbookmarks set bfg_status Ready focus .content.text @@ -620,12 +623,15 @@ proc render_handler_gopher {prevurl rooturl path body textw} { # Spartan has a status line in response and multiple MIME types # we support only text/gemini and text/plain for now proc render_handler_spartan {prevurl rooturl path body textw} { + global redirectcount redirectlimit # get the status line - if {[regexp {^(.*)\n} $body _ statusline]} { + if {[regexp {^([^\n]*)\n} $body _ statusline]} { set statusline [string trimright $statusline] set statusparts [split $statusline " "] set statuscode [lindex $statusparts 0] set statusinfo [join [lrange $statusparts 1 end] " "] + # reset redirect counter if the code group is not 3 + if {$statuscode ne 3} {set redirectcount 0} if {$statuscode eq 2} { # success - get the remaining body regsub {.*?\n} $body "" body if {[string match "text/gemini*" $statusinfo]} { @@ -640,7 +646,10 @@ proc render_handler_spartan {prevurl rooturl path body textw} { set statusinfo "/$statusinfo" } set newurl [string cat $rooturl $statusinfo] - urlfetch "$newurl" 0 + if {$redirectcount < $redirectlimit} { + incr redirectcount + urlfetch "$newurl" 0 + } } else { # error $textw insert end "Error $statuscode: $statusinfo\n" } @@ -652,16 +661,26 @@ proc render_handler_spartan {prevurl rooturl path body textw} { # Gemini is like Spartan but with a separate input logic # and relative URL support required proc render_handler_gemini {prevurl rooturl path body textw} { + global redirectcount redirectlimit if {![string match "/*" "$path"]} {set path "/$path"} if {[string match "*/" "$rooturl"]} {set rooturl [string range $rooturl 0 end-1]} set baseurl [string cat "$rooturl" "$path"] # get the status line - if {[regexp {^(.*)\n} $body _ statusline]} { + if {[regexp {^([^\n]*)\n} $body _ statusline]} { set statusline [string trimright $statusline] set statusparts [split $statusline " "] set statuscode [lindex $statusparts 0] set mainstatuscode [string index $statuscode 0] - set statusinfo [join [lrange $statusparts 1 end] " "] + set statusinfo "" + if {[llength $statusparts] > 1} { + set statusinfo [join [lrange $statusparts 1 end] " "] + } + if {($statuscode < 10) || ($statuscode > 100)} { + $textw insert end "Error $statuscode: $statusinfo\n" errormsg + return + } + # reset redirect counter if the code group is not 3 + if {$mainstatuscode ne 3} {set redirectcount 0} # we have several code groups switch $mainstatuscode { 1 { # input required @@ -691,7 +710,10 @@ proc render_handler_gemini {prevurl rooturl path body textw} { if {[::uri::isrelative $statusinfo]} { set newurl [string cat $baseurl $statusinfo] } else {set newurl $statusinfo} - urlfetch "$newurl" 0 + if {$redirectcount < $redirectlimit} { + incr redirectcount + urlfetch "$newurl" 0 + } } 6 { # client certificate status - not supported yet $textw insert end "The server requires a client certificate — not implemented yet\n"