Tkx in Perl

Putting this here so I don’t loose it.

To get Tkx to load without segfaulting, the following environment variable must be set.

export PERL_DL_NONLAZY=1

If it’s set, it works fine

Update: This can be set in a BEGIN block as follows:

BEGIN {
      $ENV{PERL_DL_NONLAZY} = 1;
}

Tcl Version of Blog generator

In my continuing re-implementing of things, I’ve also created a version of the site generation in Tcl.

Here’s the equivalent Tcl for generating the Table of Contents:

#!/usr/bin/env tclsh8.5

set output {}
foreach arg $argv {
    set fh [open $arg "r"]
    while {[gets $fh line] >= 0} {
        if {[regexp {^\#\#\#} $line]} {
            set date $arg
            regsub {^\#\#\# } $line "" line
            lappend output "<a href=\"index.html#$date\">$line</a><br>"
        }
    }
}

foreach line [lreverse $output] {
    puts $line
}

Simple Tcl Webserver

Here’s a simple webserver written in Tcl (Modified from here or here.

I added the ability to choose a port and a user and group to run as, when started as root.

# [Modified from] DustMotePlus - with a subset of CGI support
package require Tclx

set default   index.html

set port      [lindex $argv 0]
set user      [lindex $argv 1]
set group     [lindex $argv 2]
set root      "./public"

set encoding  iso8859-1
proc bgerror msg {puts stdout "bgerror: $msg\n$::errorInfo"}
proc answer {sock host2 port2} {
    fileevent $sock readable [list serve $sock]
}
proc serve sock {
    fconfigure $sock -blocking 0
    gets $sock line
    if {[fblocked $sock]} {
        return
    }
    fileevent $sock readable ""
    set tail /
    regexp {(/[^ ?]*)(\?[^ ]*)?} $line -> tail args
    if {[string match */ $tail]} {
        append tail $::default
    }
    set name [string map {%20 " "} $::root$tail]
    if {[file readable $name]} {
        puts $sock "HTTP/1.0 200 OK"
        if {[file extension $name] eq ".tcl"} {
            set ::env(QUERY_STRING) [string range $args 1 end]
            set name [list |tclsh $name]
        } else {
            puts $sock "Content-Type: text/html;charset=$::encoding\n"
        }
        set inchan [open $name]
        fconfigure $inchan -translation binary
        fconfigure $sock   -translation binary
        fcopy $inchan $sock -command [list done $inchan $sock]
    } else {
#        puts $sock "HTTP/1.0 404 Not found\n"
        puts $sock "Error - Path was: $name"
        close $sock
    }
}
proc done {file sock bytes {msg {}}} {
    close $file
    close $sock
}
socket -server answer $port
id group $group
id user $user
puts "User/Group changed to [id user] : [id group]"
puts "Server ready..."
vwait forever

I’ll probably try serving this website for a little while with this.

Fedora vs Ubuntu

As I’ve been playing around with Tcl, I’ve been struck with how much more up to date the default Tcl and libraries seem to be in Fedora rather than Ubuntu.

The default tcllib and Tclx packages in Ubuntu are still based on Tcl 8.4.

I think that’s probably at least 5 years old.