Tuesday, December 6, 2011

Perl::Tk Minimize to Systray!


After searching fruitlessly on the Perl mailing lists for a free alternative to PerlTray (from the ActiveState PDK) I have banged together my own Rube Goldberg-esque contraption which works!

I am doing it the wrong way: one thread (main) to mind the Tk GUI and another (asynchronous) which minds the SysTray icon. They send one another (window) messages in a very crude fashion which happens to be OK and somehow works cross-thread.

This may make a Win32 artist cry and that's what makes it sweet.

Also I am disrespectfully meddling with the innards of Win32::GUI::NotifyIcon. Life's good.

Enjoy the code! (You need to supply a valid Win32 ICON file named icon.ico.)

use strict;

use threads;
use threads::shared;

use Tk;

use POSIX ();
use File::Basename qw[dirname];
use File::Spec::Functions qw[ catfile rel2abs updir ];

use Win32::API;
use Win32::SysTray;

Win32::API->Import("user32", 'ShowWindow', 'II', 'I');
use constant SW_HIDE => 0;
use constant SW_RESTORE => 9;
sub win_op($$)
my $top = shift || return;
my $op = shift;
ShowWindow(hex($top->frame), $op);

Win32::API->Import("user32", 'MessageBox', 'NPPI', 'I');
use constant MB_OK => 0;
use constant MB_ICONSTOP => 16;
sub errorMessageBox($$)
my $title = shift;
my $msg = shift;

MessageBox(0, $msg, $title, MB_OK|MB_ICONSTOP);

sub Die
errorMessageBox('Sample SysTray', join('' => @_));

my $Tray : shared;
sub tray_hide()
return unless defined $Tray;
my ($handle, $id) = split /:/ => $Tray;
Win32::GUI::NotifyIcon::_Delete($handle, -id => $id); # HACK!!!
sub tray_thread($)
my $top = shift || return;

my $tray = new Win32::SysTray (
name => 'Sample SysTray',
icon => rel2abs(dirname($0)).'\icon.ico',
single => 1,
) or Die 'Win32::SysTray failed!';

$tray->setMenu (
"> &Show" => sub { win_op($top, SW_RESTORE); },
">-" => 0,
"> E&xit" => sub {
POSIX::_exit(0); # CORE::exit makes Tk barf

my $t = $tray->{Tray};
$Tray = $t->{-handle}.':'.$t->{-id};


sub main()
my $mainw = MainWindow->new(-title=>'Sample SysTray');

async { tray_thread($mainw); }

$mainw->OnDestroy(sub {
tray_hide(); # else we have zombie Systray icon
POSIX::_exit(0); # should kill background threads

my $fr = $mainw->Frame->pack(-side => 'bottom', -fill => 'x');

$fr->Button(-text => "Exit",
-command => sub { exit(0); }
)->pack(-side => 'right');

$mainw->bind('<Unmap>', sub { win_op($mainw, SW_HIDE); } );



Thursday, November 24, 2011

On using UPX on Static linux-i386 Binaries

On an embedded target I work binaries on are stored on a CF card which has about 1.8M/s read speed. However the static binary in question is about 40M uncompressed or 8M gzip'ed.

As in the old Stacker days the box can decompress faster than it reads from CF so a compromise has been reached: store the binary gzip'ed, decompress to /tmp (a ramdisk) and run from there.

This embedded system does not have swap enabled but the kernel in low mem situations uses demand paging for the r/o pages in the .text area of a binary. I.e. it steal LRU code pages from in-core knowing they will be found in the on-disk binary. This is why one gets a Text file busy error when one tries to alter a binary which is running.

In our case we end up with basically two copies of the binary in-core (this a GCJ-compiled Java app so the .text is fairly substantial tho 90% of it is junk).

Then I took the upx -9 route and the results are quite interesting. The compressed binary shrank to 7M which means faster load time and a smaller software installer.

Here is some sample C code:
int main()
char c = 0;
printf("Press ENTER:"); fflush(stdout);
read(0, &c, 1);
return 0;
The static stripped binary is 377,204 bytes and the upx'ed static binary is 174,880 bytes. size(1) reports for a.out:
   text    data     bss     dec     hex filename
371111 3144 4448 378703 5c74f a.out
Running and suspending the binaries we get:
VmSize 516 kB 524 kB
VmLck 0 kB 0 kB
VmRSS 124 kB 96 kB
VmData 140 kB 508 kB
VmStk 8 kB 12 kB
VmExe 364 kB 4 kB
VmLib 0 kB 0 kB

So upx moves the code from .text to the data of the running binary. Demand paging bye-bye but at least we don't (theoretically) keep two copies of .text in core.

In practice Linux cheats and does not fault in all the pages of the binary when loading it... it loads enough to make it start and it's lazy about the rest... if the binary needs those pages they will be faulted in later.

Or this is a bed-time story for bearded UN*X hackers.


Wednesday, September 21, 2011

A Thing of Beauty!

Check out the uptime in the screenshot -- it's 1340 days which is 3 years and 8 months. Take that N3tcraft!

This is the router I've used for my backup DSL line for 2 years. True, I've disconnected the line 18 months ago but the box is still chugging along in a closet in my basement thanks to a decent UPS and my neglect ;-)

Alas I have to move this box to a new location and possibly decommission it.


Tuesday, August 23, 2011

A Fiercer Way To Detect a CD-ROM/DVD Driver Letter Under Cygwin/MinGW

This works even under MinGW and has a wicked bit of AWK to parse Unicode cr*p:
reg query 'HKLM\SYSTEM\MountedDevices' | \
awk 'BEGIN { letter=""; }
d=$1; a=$NF;
dr=substr(d, length("\\DosDevices\\")+1, 1);
i=0; str="";
while(length(a) > 0) {
c=substr(a, 0, 2); a=substr(a,3);
if((++i%2)==0) { continue; }
str = str sprintf("%c", strtonum("0x" c));
if(verbose) { print dr ": " str > "/dev/stderr"; }
if(tolower(str) ~ /cdrom/) { letter=dr; }
if(length(letter) > 0) { print letter; }
else { exit 1; }

Monday, August 22, 2011

On Guilty Perl/Win32 Pleasures

I've been messing with PerlApp-packaged gui Perl apps for a while and I was annoyed that stderr output (useful when debugging) was not available when having the exe type set to Win32.

I have just remembered about an obscure W*ndows feature: debug messages (a lame-arse feature cloning syslogd(8) and only available in a debugger). So I set myself to use this having fond a debug message viewer http://alter.org.ua/soft/win/dbgdump/DbgPrnHk_v9a_all.rar.

The question was how to log to stderr when running as a console app (under perl.exe) and to the debug message subsystem if running as a non-console app (unde wperl.exe)?

I found no direct answer but kernel32!GetConsoleTitle can be used in an indirect way to answer this question:
#!perl -w
use strict;
use Win32::API;
use File::Basename qw(basename);
my $myself = basename($0);
Win32::API->Import("kernel32", 'OutputDebugStringA', 'P', 'V');
Win32::API->Import("kernel32", 'GetConsoleTitle', 'PN', 'I');
sub DbgPrint
OutputDebugStringA("$myself\[$$\]: ".join('' => @_)."\r\n");
sub isConsole()
my $title = 'x' x 128;
my $r = GetConsoleTitle($title, 128);
return if $r == 0;
return if $title =~ /^x+x$/;
return 1;
sub Log
not @_ and return;
return print(STDERR @_, "\n") if isConsole();
return DbgPrint(@_);
main::Log "Testing";
I must say that Dave Roth's book Win32 Perl Scripting: The Administrator's Handbook was an eye opener to all sorts of deliciously perverse Perl/Win32 programming tidbits.


P.S. Why not use the Event Log subsystem? Because is sucks even more than the debug messages subsystem! and because I like obscure features and because the debug messages are not on-disk persistent.

Friday, August 19, 2011

A Smart but Neglected BASH Feature

I had a humongous shell script and a wish to redirect stderr for a boat load of commands in one fell swoop. I could have used the {} grouping but for obscure reasons it was not appropriate.

The answer was to write a Bash extension in C which takes advantage of two things:
a) Bash does not fork(2) when it executes an extension so it's in-process;
b) dup2(2)
so it's possible to do funky things with the file descriptors and get away with it.

Alas on Win32 Cygwin's bash does not load this extension (MinGW does) and dup2(2) is just borked. Blame M$ for designing a braindead C library and OS.

Here's the code:
#include <stdio.h>
#include <errno.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <asm/fcntl.h>
#include <errno.h>

#include "builtins.h"
#include "shell.h"

// Compile on Linux/x86:
// gcc -I/tmp/bash-3.2 -I/tmp/bash-3.2/include fdmangle.c -fpic -c
// ld -x -Bshareable -o fdmangle.so fdmangle.o
// Use in shell scripts:
// enable -f ./fdmangle.so fdmangle
// fdmangle 2 stderr

extern char **make_builtin_argv(); // Bash-ism

static int verbose = 0;

static int fdmangle_main(int argc, char **argv)
if(argc < 3) {
return 1;

int n = 1;
if(!strcmp(argv[1], "-v")) { verbose = 1; n++; }

if(verbose && argc < 4) {
return 1;

const int fdn = atoi(argv[n]);
const char* file = argv[n+1];

if(verbose) fprintf(stderr, "fdmangle %d -> %s\n", fdn, file);

int flags = O_CREAT | O_WRONLY | O_APPEND;
#ifdef __unix__
flags |= O_NOFOLLOW;
int fd = open(file, flags, 0640);
if(fd < 0) {
fprintf(stderr, "Cannot open for writing %s: %d (%s)\n", file, errno, sys_errlist[errno]);

dup2(fd, fdn);

return 0;

static int fdmangle_builtin(WORD_LIST *list)
char **v=NULL;
int c=0, r=0;

v = make_builtin_argv(list, &c);
r = fdmangle_main(c, v);

return r;

static char* fdmangle_doc[] = {
"File descriptor mangling",
(char *)0

struct builtin fdmangle_struct = {
"fdmangle [-v] fd file",

Monday, August 8, 2011

How To Detect a CD-ROM/DVD Driver Letter Under Cygwin

While automating a provisioning process I stumbled upon this issue... How do you know what drive letter is a CD-ROM?

The first try was:
grep -qw iso9660 /proc/mounts || return 1;

echo $(mount | awk '/iso9660/{print $3}')
which happens to work when a disk is inserted in the drive.

At my deliverables demo the disk was not present so bummer.

The second uses the Registry and works (in XP):

for dr in D E F G H I J K L M N O P Q R S T U V W X Y Z
[ -e /proc/registry/HKEY_LOCAL_MACHINE/SYSTEM/MountedDevices/%5CDosDevices%5C${dr}%3A ] || continue;
tr -d '\00' < /proc/registry/HKEY_LOCAL_MACHINE/SYSTEM/MountedDevices/%5CDosDevices%5C${dr}%3A | grep -qi cdrom || continue;
[ -z "$cdrom" ] && return 1;
echo /cygdrive/$(echo $cdrom | tr 'A-Z' 'a-z');
Brutal, eh?

grep -qw iso9660 /proc/mounts || return 1;
is a great way to check whether a disk is in the unit (any unit).


Wednesday, July 27, 2011

The Scripting of ssh(1) Conundrum

Now as before I am trying to do automation of remote SSH operations. ssh(1) is particularly unfriendly to that. Ditto scp(1)

It can be done using a masochistic trio:
1. set SSH_ASKPASS, provide an askpass program;
2. set DISPLAY to something;
3. run ssh under setsid(1)
but that precludes access to $?

In the past I've worked around that by using Perl's Net::SSH::Perl (very slow) or by using Dropbear which is MIT-licensed.

This time as my automation Bash script must run under Linux and Cygwin/Win32 I have elected to use plink/pscp which are native to Windows, lend themselves easily to scripting, mirror stdin/stderr and which to my pleasure compile cleanly on Linux and work as designed.

One leg up for Simon and legacy boos to Tatu and the OpenBSD team.


Tuesday, June 21, 2011

Using a WindMobile Huawei E1691USB stick in Linux

This piece of Chinese-designed cr*p is a dual-use USB stick, i.e. it has a dual personality as a USB device. In its "native" state it looks like a CD-ROM (so you can install the drivers in Windows and MacOS off it) yet it has to be reset with a "secret handshake" to look like a COM port.

I g00gled for this and found no good answer but some good bits. And here is how they came together:
1. you need the usbserial and a recent copy of the option [GSM driver] modules loaded;
2. the reset sequence (via usb_modeswitch):
# Huawei E1691
DefaultVendor= 0x12d1
DefaultProduct= 0x1446
TargetVendor= 0x12d1
TargetProduct= 0x140c
3. I connected via vwdial, this is the config file for it [it's Wind-specific]:
[Dialer Defaults]
Init1 = ATZ
Init2 = ATQ0 V1 E1 S0=0 &C1 &D2 +FCLASS=0
Init4 = AT+CGDCONT=1,"IP","broadband.windmobile.ca"
Modem Type = Analog Modem
Baud = 115200
New PPPD = yes
Modem = /dev/ttyUSB0
ISDN = 0
Phone = *99#
Password = gprs
Username = gprs
I used Knoppix 6.4.4 to connect and it worked beautifully.

Mind you you need good signal (which can be a problem with Wind).

VMware/Windows note: if you run Linux in a VM and you assign the USB stick to it then when you use usb_modeswitch it will cause the stick to re-enumerate and kick some "Found New Hardware" dialogs in Windows. Ignore them (Cancel).


Tuesday, May 17, 2011

MTU/Fragmentation Strikes Again

I have this strange setup:

A <---OpenVPN/TCP over SSH--> B <--localnet--> C

:5432 ---DNAT---> :5432
in which host A is a VPS server somewhere in Illinois and hosts B & C are at home.

Host A needs to connect to a PostgresQL server running on C but for obscure reasons I do not want to run full routing/masquerading on B so I put a DNAT rule so A connecting to B:5432 in effect talks to C:5432

I had problems with a SQL insert A->C (it was the body of an e-mail). My test case message had just a few bytes in the body so the INSERT was completing A-OK.

However in real use this insert was taking forever and my Milter was timing out as a result (brr). Debugging on A was rather harsh as it's a VM with SElinux enabled so many things around ptrace(2) are borked.

After a few missteps I divined that the default MTU for the VPN interface (1500) was 1500 and since the link A->B is point-to-point (A is blissfully unaware of C's existence) A will never perform a path MTU discovery.

The fix was to lower the MTU to 1300 (be on the safe side as I did not bother to measure the overhead of the SSH envelope) on A and B.


Monday, May 16, 2011

Compressed Output from Bash CGI Scripts

I have blogged before on how to compress the output of Per CGIs. As I've started to use and Android phone I learned that some of my status pages dump a heck of a lot of output. A few are written ad Bash CGI scripts.

So here's how to repeat the trick in Bash:

echo $HTTP_ACCEPT_ENCODING | grep -qw gzip && {
gz='ok'; gz_pipe='gzip -9f';

echo "Content-Type: text/html";
[ ! -z "$gz" ] && echo "Content-Encoding: gzip";
echo '';

echo '<html><PRE>';
ps axf
echo '</PRE></html>';
} | $gz_pipe
For user agents that do not accept gzip-encoded output we use cat(1) as a straight pass-thru as there is no 'nice way' to put nil afer a pipe sign (|) in Bash.


Wednesday, March 2, 2011

On Webapps

I have always loathed GUI apps and especially HTML webapps. And this is not for lack of trying (I once wrote an asset-tracking app using HTML 3.2 and Bash shell scripts as backend).

At my current contract I was asked to write a custom webapp for time tracking (alas nothing was available as open source which fulfilled the requirements). At my previous position I have seen my co-workers build a fairly beefy webapp as a network appliance configurator using YUI2. I tried to stay away from it as I was having more fun writing C++ backends.

Now I had to do it front and back so I wrote some Java servlets that interact with a MySQL db which a) act as XML-RPC endpoints so one can set values and b) as XML generators [SQL table format to XML/table format translators] for data presentation. I tried to keep the Java back-end as straight-thru as possible.

I managed to keep most of the business logic in SQL as materialised views. Yppie!!

I sinned a bit as I provided a thin Perl layer that sometimes takes the raw XML output from Java and spits out JavaScript or JSON. I had to as the servlets run on Jetty on localhost:8080 so there was no direct access from the browser.

I could have configured Jetty as a full web browser but it's a royal pain in the arse to do so.

For the front-end I went the full hog with YUI2! I used a bit of extra JavaScript to do the XML-RPC (and I got a buggy client implementation to contend with) and JSON bits. I also sinned a bit with JQuery.

Other than that I've done it screen by screen using YUI and DataTable (DataSource is horribly interlinked with DataTable -- for the life of me I could not beat a DataTable into being used as stand-alone; so I went JSON/JQuery). In the end I assembled the individual/standalone pages using a TabView and iframes (evil, I know).

The webapp actually looks good and is pretty snappy once the JIT compiler kicks in. For the Perl bits I configured mod_perl (with a lot of preloaded Perl modules) as I did not like the 100 ms hit I got every time I was calling a Perl cgi.

I handled a form of basic authentication using Apache's .htaccess, mod-rewrite for setting the access rights (sigh) and Perl for session handling. The browser is handled a random cookie which represents the session.

I deployed all the shebang on an OpenSuSE 11.0 VM I had lying around and it only took me a 1G .vmx file to do so.

So I am happy with the result and with the YUI2 capabilities. I even added a flourish of a YUI2/Flash chart to show availability levels. I did not have to sweat a bit on HTML and JavaScript to build up a good-looking functional GUI, it worked out of the box in Firefox and IE6 (yes I work for such a unupgradable corp) and it only took two weeks to build.


P.S. There's talk of AD authentication but that ought to be handled by an Apache module if AD has LDAP well configured.