From mboxrd@z Thu Jan 1 00:00:00 1970 From: Pedro Larroy Date: Sat, 12 Oct 2002 21:06:02 +0000 Subject: [LARTC] Htb frontend starting to work MIME-Version: 1 Content-Type: multipart/mixed; boundary="HcAYCG3uE/tztfnV" Message-Id: List-Id: To: lartc@vger.kernel.org --HcAYCG3uE/tztfnV Content-Type: text/plain; charset=us-ascii Content-Disposition: inline Hi. I have something that can be seen now. It would be nice if you give it a try to see if you find it useful and if it detects correctly the htb tree. Send me your comments. Regards. -- ... ___________________________________________________________ ... | /| |\ | | /-| Pedro Larroy Tovar. PiotR | http://omega.resa.es/piotr |-\ | | /--| No MS-Office attachments please. |--\ | o-|--| e-mail: piotr@omega.resa.es |--|-o | \-| finger piotr@omega.resa.es for public key and info |-/ | |...\|_________________________________________________________|/...| --HcAYCG3uE/tztfnV Content-Type: application/x-perl Content-Disposition: attachment; filename="qos.pl" Content-Transfer-Encoding: quoted-printable #!/usr/bin/perl -w=0A######################################################= ####################=0A#=0A# Many Thanks to:=0A# The people of #perl in fre= enode for his patience and kind answers to my=0A# questions.=0A# Bert Huber= t and Hightower for motivating me to finish this project.=0A#=0A# =0A#= =0A#=0A#=0A#=0A#=0A#=0A#=0A#=0A#=0A#=0A#=0A#=0A############################= ##############################################=0A=0Ause Gtk;=0Ause Gtk::Gdk= ::ImlibImage;=0Ause strict;=0Ause warnings;=0A=0Aset_locale Gtk;=0Ainit Gtk= ;=0A=0A#=0A# Global Program variables=0A# =0Amy $false =3D 0;=0Amy $true = =3D 1;=0A=0Amy $window;=0Amy $main_vbox;=0Amy $ctree;=0A=0A my ($closed, $c= losed_mask);=0A my ($opened, $opened_mask);=0A my ($leaf, $leaf_mask); =0A#= =0A# Array of network interfaces=0A# =0Amy @netifaces;=0A=0A# Main program= =0A#=0A# =0A# Create Main Window=0A$window =3D new Gtk::Window( "toplevel" = );=0A$main_vbox =3D new Gtk::VBox($false, 1);=0A$window->set_usize( 500, 30= 0 );=0A$window->set_title( "QoSillas" );=0A$window->signal_connect( "destro= y", sub { Gtk->exit( 0 ); } );=0A$window->border_width( 5 );=0A$window->rea= lize();=0A$window->add($main_vbox);=0A$main_vbox->show();=0A=0A=0A=0Acreate= _ctreewin();=0Acreate_rrdwin();=0A=0Ascan_network_interfaces();=0A$window->= show();=0A=0Amain Gtk;=0Adie "oops, out of the gtk loop!\n";=0A#=0A#=0A# Ma= in program end=0A=0A#=0A# Program Functions=0A# =0A#=0A=0Asub sanity_checks= {=0A if ( $> ne "0" ) {=0A printf "Warning: You are not root, you won't b= e able to change qdiscs\n";=0A }=0A if ( ! -x "/sbin/tc" ) {=0A die "Error= : /sbin/tc must be executable for this program to work\n";=0A }=0A}=0A=0A= =0Asub create_ctreewin {=0A my $menubar;=0A my $item_factory;=0A = my $accel_group;=0A =0A my $ctree_vbox;=0A my @menu_items= =3D ( { path =3D> '/_Actions',=0A type =3D> '= ' },=0A { path =3D> '/Actions/_Rescan network interfaces',=0A = accelerator =3D> 'R',=0A callback =3D> \&scan_netw= ork_interfaces },=0A { path =3D> '/Actions/sep1',=0A typ= e =3D> '' },=0A { path =3D> '/Actions/Quit',= =0A callback =3D> sub { Gtk->exit( 0 ); } },=0A=0A { path = =3D> '/_Options',=0A type =3D> '' },=0A { p= ath =3D> '/Options/Test' },=0A=0A { path =3D> '/_Help',= =0A type =3D> '' },=0A { path =3D> '/= _Help/About',=0A callback =3D> \&about });=0A # Ctree stuf= f=0A #=0A #=0A my @titles =3D ("Interface","Discipline","type= ","prio","rate","ceil","burst","cburst");=0A=0A #=0A my $scrolled_window;= =0A=0A # Auxiliar variables=0A my $i;=0A=0A # Working variables=0A my $ifac= e;=0A my @rootnode;=0A my $tree;=0A=0A my @closed_xpm =3D ( "16 16 6 1",=0A= " c None s None",=0A ". c black",=0A "X c r= ed",=0A "o c yellow",=0A "O c #808080",=0A "# = c white",=0A " ",=0A " .. ",=0A = " ..XX. ",=0A " ..XXXXX. ",=0A " ..XXXXXXXX. ",= =0A ".ooXXXXXXXXX. ",=0A "..ooXXXXXXXXX. ",=0A ".X.ooXXXX= XXXXX. ",=0A ".XX.ooXXXXXX.. ",=0A " .XX.ooXXX..#O ",=0A "= .XX.oo..##OO. ",=0A " .XX..##OO.. ",=0A " .X.#OO.. ",= =0A " ..O.. ",=0A " .. ",=0A " = ");=0A my @open_xpm =3D ( "16 16 4 1",=0A " c None s None",= =0A ". c black",=0A "X c #808080",=0A "o c white",= =0A " ",=0A " .. ",=0A " .Xo. ... = ",=0A " .Xoo. ..oo. ",=0A " .Xooo.Xooo... ",=0A " .Xooo.oooo.= X. ",=0A " .Xooo.Xooo.X. ",=0A " .Xooo.oooo.X. ",=0A " .Xooo.Xo= oo.X. ",=0A " .Xooo.oooo.X. ",=0A " .Xoo.Xoo..X. ",=0A " .Xo= .o..ooX. ",=0A " .X..XXXXX. ",=0A " ..X....... ",=0A " = .. ",=0A " ");=0A my @leaf_xpm =3D ( "16 16 4 1= ",=0A " c None s None",=0A ". c black",=0A "X c wh= ite",=0A "o c #808080",=0A " ",=0A " .......= ",=0A " .XXXXX.. ",=0A " .XoooX.X. ",=0A " .XXX= XX.... ",=0A " .XooooXoo.o ",=0A " .XXXXXXXX.o ",=0A " .= XooooooX.o ",=0A " .XXXXXXXX.o ",=0A " .XooooooX.o ",=0A " = .XXXXXXXX.o ",=0A " .XooooooX.o ",=0A " .XXXXXXXX.o ",=0A = " ..........o ",=0A " oooooooooo ",=0A " ");= =0A=0A=0A # Right button menu=0A #=0A =0A my $menu_item;=0A my $menu_item2;= =0A my $menu;=0A #=0A # =0A=0A $ctree_vbox =3D new Gtk::VBox(= $false, 1 );=0A $ctree_vbox->border_width( 1 );=0A=0A #=0A #= Creation of menubar=0A #=0A=0A=0A=0A $accel_group =3D new Gt= k::AccelGroup();=0A $item_factory =3D new Gtk::ItemFactory( 'Gtk::Me= nuBar',=0A '
',=0A = $accel_group );=0A $item_factory->creat= e_items( @menu_items );=0A $window->add_accel_group( $accel_group );= =0A $menubar =3D $item_factory->get_widget( '
' );=0A=0A $ctree= _vbox->pack_start( $menubar, $false, $false, 0 );=0A $menubar->show();=0A $= main_vbox->pack_start( $ctree_vbox,$true,$true,0 );=0A #$ctree_vbox-= >realize();=0A $ctree_vbox->show();=0A=0A=0A #=0A # Ct= ree Creation=0A #=0A=0A =0A ($closed, $closed_mask) =3D initialize_p= ixmap( @closed_xpm );=0A ($opened, $opened_mask) =3D initialize_pixmap( @op= en_xpm );=0A ($leaf, $leaf_mask) =3D initialize_pixmap( @leaf_xpm );=0A=0A = # Create Scrolled Window=0A $scrolled_window =3D new Gtk::ScrolledWindow( u= ndef, undef );=0A $ctree_vbox->pack_start( $scrolled_window, $true, $true, = 0);=0A $scrolled_window->set_policy( 'automatic', 'always' );=0A $scrolled_= window->show();=0A=0A $ctree =3D new_with_titles Gtk::CTree ( 0, @titles );= =0A $ctree->set_column_width( 0, 150 );=0A=0A $scrolled_window->add($ctree)= ;=0A $ctree->show();=0A =0A # Rigth button menu=0A $menu =3D new Gtk::Menu(= );=0A =0A $menu_item =3D new Gtk::MenuItem("Delete");=0A $menu->append($men= u_item);=0A $menu_item->signal_connect( 'activate',\&delete_node, $ctree );= =0A $menu_item->show();=0A=0A $menu_item2 =3D new Gtk::MenuItem("Draw class= activity");=0A $menu->append($menu_item2);=0A $menu_item2->signal_connect(= 'activate', sub { print( "JAAAAAI iDRAAWPAAAyo\n" ); } );=0A $menu_item2->= show();=0A=0A # Add handlers=0A $ctree->signal_connect( 'tree_select_row', = sub {=0A my ($ct, $node, $col) =3D @_;=0A my ($t, $space);=0A # print "C= olumn: $col -> $node\n";=0A ($t, undef, undef) =3D $ct->node_get_pixtext($= node, 0);=0A print "node_get_pixtext Info O: $t\n";=0A $t =3D $ct->node_g= et_text($node, 1);=0A print "node_get_text Info 1: $t\n";=0A ($t, $space)= =3D $ct->get_node_info($node);=0A print "NInfo: '$t' $space\n";=0A } );= =0A $ctree->signal_connect( 'button_press_event', \&ctree_button_press, $me= nu );=0A=0A =0A}=0A=0Asub create_rrdwin()=0A{=0A my $hbox;=0A = my $menubar;=0A my @menu_items =3D ();=0A my $scrolled_windo= w;=0A my $button;=0A=0A my $im =3D load_image Gtk::Gdk::Imlib= Image("rrd.gif");=0A my $w =3D $im->rgb_width;=0A my $h =3D $= im->rgb_height;=0A $im->render($w,$h);=0A=0A $hbox =3D new Gt= k::HBox( $true, 1 );=0A $hbox->border_width( 1 );=0A=0A # Create Scr= olled Window=0A #$scrolled_window =3D new Gtk::ScrolledWindow( undef, undef= );=0A #$scrolled_window->set_policy( 'automatic', 'always' );=0A #= =0A #=0A #=0A $button =3D new Gtk::Button( "Quit" );= =0A $button->signal_connect( "clicked", sub { Gtk->exit( 0 ); } );= =0A #$scrolled_window->add($button);=0A $hbox->pack_start( $button, = $true, $true, 0);=0A #$scrolled_window->show();=0A $main_vbox->pack_= start($hbox,$false,$false,0);=0A $hbox->show();=0A $button->s= how();=0A=0A}=0A=0Asub ctree_button_press =0A{=0A my( $ctree, $menu,= $event ) =3D @_;=0A if ( $event->{button} =3D=3D 3 ) {=0A $menu->popup( u= ndef, undef, undef, $event->{'button'}, undef );=0A }=0A =0A=0A}=0A=0Asub = delete_node =0A{=0A my ( $menu, $ctree, $event ) =3D @_;=0A my @selection;= =0A my ( $row, $column ) =3D $ctree->get_selection_info( $event->{'x'}, $ev= ent->{'y'} );=0A my $node;=0A my $position;=0A printf "Button press subrout= ine $row $column\n";=0A @selection =3D $ctree->selection();=0A foreach $nod= e ( @selection ) {=0A # $ctree->remove_node($node);=0A printf $ctree->get_= node_position ($node) . "\n";=0A }=0A}=0A=0Asub initialize_pixmap=0A{=0A = my @xpm =3D @_;=0A=0A my $pixmap;=0A my $mask;=0A my $style =3D $wind= ow->get_style()->bg( 'normal' );=0A=0A ($pixmap, $mask) =3D Gtk::Gdk::Pix= map->create_from_xpm_d( $window->window, $style, @xpm );=0A=0A return ( $= pixmap, $mask );=0A}=0A=0A=0A=0Asub scan_network_interfaces =0A{=0A = my @file;=0A my $fh;=0A my $line;=0A my $i=3D0;=0A=0A if ( -r "/proc= /net/dev" ) {=0A open($fh , "/proc/net/dev");=0A } else {=0A = die "Error: I can't access /proc/net/dev, either change permission= s or check if /proc is mounted";=0A }=0A =0A if( @netifaces ) {=0A my $pos= ition;=0A for (@netifaces) {=0A $position =3D $ctree->get_node_position = ($netifaces[$i]->{"node"});=0A $ctree->remove($position);=0A $i++;=0A = } =0A }=0A=0A undef @netifaces;=0A $i=3D0;=0A @file =3D <$fh>;=0A sh= ift @file;=0A shift @file;=0A foreach $line (@file) {=0A $line =3D~ /(\w*)= :/;=0A push @netifaces,{ name =3D> "$1", node =3D> "undef", qdiscs =3D> [ = ],qdrootnode =3D> "" };=0A }=0A $i=3D0;=0A for (@netifaces) {=0A $netiface= s[$i]->{"node"} =3D $ctree->insert_node(undef, undef, [$netifaces[$i]->{"na= me"}, "","hw","","","",""], 5 , $closed, $closed_mask, $opened, $opened_mas= k, $false, $true);=0A $i++;=0A }=0A =0A scan_qdiscs();=0A = =0A=0A}=0A=0A=0A=0Asub scan_qdiscs =0A{=0A my @tc_out;=0A my = $line;=0A my $iface;=0A my $i=3D0;=0A my $sibling =3D undef;= =0A for (@netifaces) {=0A @tc_out =3D `/sbin/tc class= show dev $netifaces[$i]->{"name"}`;=0A #=0A = #=0A foreach $line (@tc_out) {=0A if(= $line =3D~ m/class\D+htb\D+(\d+:\d+)\D+root\D+rate\D+(\d+)Kbit\D+ceil\D+(\= d+)Kbit\D+burst\D+(\d+)\D+cburst\D+(\d+)/ ) {=0A # $= 1 ID=0A # $2 Rate =0A # $3 Ce= il=0A # $4 Burst=0A # $5 Cbur= st=0A push @{ $netifaces[$i]->{"qdiscs"} },$1;=0A $netifaces[$i]->{"q= drootnode"} =3D $ctree->insert_node($netifaces[$i]->{"node"},$netifaces[$i]= ->{"qdrootnode"}, ["$1", "HTB","$1","NA","$2","$3","$4","$5"], 5 ,$leaf, $l= eaf_mask, undef, undef, $false, $false);=0A = print "\t a=F1adido: $1 $2 $3 $4 $5";=0A =0A= }=0A }=0A =0A = foreach $line (@tc_out) {=0A if( $line =3D~ = m/class\D+htb\D+(\d+:\d+)\D+parent\D+(\d+:\d+)\D+prio\D+(\d+)\D+rate\D+(\d+= )Kbit\D+ceil\D+(\d+)Kbit\D+burst\D+(\d+)\D+cburst\D+(\d+)/ ) { =0A $sibl= ing =3D $ctree->insert_node($netifaces[$i]->{"qdrootnode"},$sibling, [$1, "= HTB","$1","$3","$4","$5","$6","$7"], 5 ,$leaf, $leaf_mask, undef, undef, $t= rue, $false);=0A print "\t a=F1adido: $1 $2 = $3 $4 $5";=0A }=0A }=0A=0A=0A = =0A #=0A #=0A #=0A = #=0A $i++;=0A }=0A}=0A=0A --HcAYCG3uE/tztfnV-- _______________________________________________ LARTC mailing list / LARTC@mailman.ds9a.nl http://mailman.ds9a.nl/mailman/listinfo/lartc HOWTO: http://lartc.org/