#!/usr/bin/perl -Tw use strict; my $FIFO = '/tmp/tricky.fifo'; my $DIALDCTL = '/etc/diald/diald.ctl'; my $STATUS = '/tmp/diald.status'; my $st = 0; my $dialdState = "DOWN"; $SIG{CHLD} = sub { wait }; unless (-p $FIFO) { unlink $FIFO; system('/usr/bin/mkfifo','-m','666',$FIFO) && die "Can't mkfifo $FIFO: $!"; } my $pid; if ($pid = fork) { open (FIFO, "< $FIFO") || die "can't read $FIFO: $!"; } elsif (defined $pid) { open (DIALDCTL, "> $DIALDCTL") || die "can't open $DIALDCTL: $!"; print DIALDCTL "monitor $FIFO\n"; close DIALDCTL; exit; } else { die "Can't fork: $!\n"; } my $msg = 0; open (STATUS, "> $STATUS") || die "can't open status file $STATUS: $!"; select STATUS; $| = 1; # set flush-on-write while (<FIFO>) { if ($st == 1) { $st = 0; if (m/^CONNECT/) { close STATUS; unlink $STATUS; open (STATUS, "> $STATUS") || die "can't open status file $STATUS: $!"; select STATUS; } print; } if ($msg == 1) { $msg = 0; print; } if (m/^STATE/) { $st = 1; } elsif (m/^MESSAGE/) { $msg = 1; } }