firewall.pli

net plug source code

# (Sun) Firewall (itelnet) plugin for				 -*- tcl -*-
# NetPlug general network client in Tcl/Tk
# http://www.demailly.com/~dl/netplug.html 
#
# Copyright 1997
# by Laurent Demailly - [e-mail] - http://www.demailly.com/~dl/
#
# $Id:
#
# $Log: firewall.pli,v $
# Revision 1.2  1997/10/27 05:33:47  dl
# removed sun specific infos
#
# Revision 1.1  1997/10/18 18:29:47  demailly
# Initial revision
#
#

global fire;
# keywords
regexp {[.0-9]+} {$Revision: 1.2 $} sf(version)

proc FireInit {onoff} {
  global env host port clone netmod;
  set w .conn
  if {$onoff} {
    # use our connect proc
    rename DoConnect FireDoConnect_ 
    rename FireDoConnect DoConnect
    if {!$netmod} FireConfigEdit;
  } else {
    # restore standard command
    rename DoConnect FireDoConnect
    rename FireDoConnect_ DoConnect
  }
}

catch {rename FireDoConnect_ {}}

proc FireDoConnect {n host port} {
    global fire;
    defOut $n 0 "- Connecting using firewall (async)... Please Wait... " syst;
    update
    # connect to the host
    if {[catch {set sock [socket -async $fire(host) $fire(port)]} msg]} {
      defOut $n 1 "Connect error on $fire(host) port $fire(port) : $msg -";
      return "";
    }
    fconfigure $sock -translation binary;
    defOut $n 0 "Connected to $fire(host) $fire(port) : requesting\
	         connect to $host $port\n" syst;
    # we expect precisely to see 5 chars "(to) "
    # then 2 lines coming from the proxy...
    defOut $n 0 ">> " syst; update;
    defOut $n 0 [read $sock 5];
    puts $sock "$host $port"; 
    if {[catch {flush $sock} msg]} {
	defOut $n 1 "-ERR writing to firewall ($msg)-\n";
    } else {
	defOut $n 0 "$host $port\n" syst;
    }
    defOut $n 0 ">> " syst; update; 
    defOut $n 0 "[gets $sock]\n" ;
    defOut $n 0 ">> " syst; update;
    defOut $n 0 "[gets $sock]\n" ;
    if {[eof $sock]} {defOut $n 1 "-EOF from firewall-"};
    fconfigure $sock -translation auto;
    return $sock;
}


array set fire {
  host {enter firewall hostname here}
  port 3666
}

proc FireConfigEdit {} {
  set w .sfconf;
  catch {destroy $w}
  toplevel $w;
  wm title $w "FireWall Config...";
  label $w.l1 -text "Firewall Port"
  entry $w.e1 -textvariable fire(port) -width 6;
  label $w.l2 -text "Firewall Host";
  entry $w.e2 -textvariable fire(host) -width 20;
  grid configure  $w.l2 $w.e2 -sticky w -padx 1m -pady 1m;
  grid configure  $w.l1 $w.e1 -sticky w -padx 1m -pady 1m;

  button $w.bok -text "Ok/Dismiss" -command "destroy $w";
  button $w.bsv -text "Save" -command fire_save;
  grid configure  $w.bok $w.bsv -sticky we -padx 2m -pady 3m
  bind $w <Return> "$w.bok invoke"
}


proc fire_load {{fname ""}} {
  if {[cequal "" $fname]} {
    global dotdir fire;
    set fname "$dotdir/firerc";
    uplevel #0 [list source $fname];
    return $fname;
  } else {
    uplevel #0 "source $fname"
    return $fname;
  }
}

proc fire_save {{fname ""}} {
  global fire;
  if {[cequal "" $fname]} {global dotdir;set fname "$dotdir/firerc"}
  catch {file rename -force $fname $fname.bak}
  set f [open $fname w];
  #SAVEDVARS
  foreach v { host port } {
    puts $f "set fire($v) [list $fire($v)]";
  }
  close $f;
  puts "save in $fname";
  return $fname;
}


# load stuff (eventually)
if {[catch fire_load err]} {
  puts stderr "Fire: error loading optional config file : $err";
}


list "FireWall ..." FireInit;