Small tool to generate ladder diagrams for network protocols. obsoleted by mscgen.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
gen_ladder/gen_ladder.pl

178 lines
3.9 KiB

#!/usr/bin/perl -w
use strict;
# Script to generate Graphviz (.dot) based ladder diagrams for network
# protocols
#
# (C) 2010 by Harald Welte <laforge@gnumonks.org>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
my $cfg_parse_state;
my $cfg_parse_section;
my %cfg_entities;
my @cfg_entity_arr;
my $cfg_nr_entities = 0;
my @cfg_messages;
# parse a line of the config file
sub parse_cfg_line($)
{
my $line = shift;
if ($line =~ /^\#/ ||
$line =~ /^\s*$/) {
return;
}
#printf("sec=%s\n", $cfg_parse_section);
if ($line =~ /^\[/) {
($cfg_parse_section) = $line =~ /^\[(.*)\]/;
return;
}
if ($cfg_parse_section eq 'entities') {
my ($entity) = $line =~ /^(\w+)/;
$cfg_entities{$entity} = $cfg_nr_entities++;
push(@cfg_entity_arr, $entity);
} elsif ($cfg_parse_section eq 'messages') {
my ($src, $dst, $label, $flags) =
$line =~ /(\w+)\s+(\w+)\s+"(.*)"(.*)/;
my %msg;
$msg{'src'} = $src;
$msg{'dst'} = $dst;
$msg{'label'} = $label;
$msg{'flags'} = $flags;
# store a reference to the new hash on the global pile of
# message hash references
#print("$src $dst $label $flags\n");
push(@cfg_messages, \%msg);
}
}
# parse a line of the config file
sub parse_cfg_file($)
{
my $fname = shift;
open(INFILE, "<$fname");
while (my $line = <INFILE>) {
#print($line);
chomp($line);
parse_cfg_line($line);
}
close(INFILE);
}
# generate the nodes between which we will transfer messages
sub gen_nodes()
{
my $num_msgs = @cfg_messages;
foreach my $m (@cfg_entity_arr) {
printf(" %s [shape=none]\n", $m);
}
print("\n");
foreach my $m (@cfg_entity_arr) {
my $first = 0;
my $count;
# initial edge between header entity and the chain
printf(" %s -> %s0 [style=invis]\n", $m, $m);
# chain of edges between the individual nodes of one entity
for ($count = 0; $count < $num_msgs+1; $count++) {
my $name = sprintf("%s%u", $m, $count);
if ($first == 0) {
printf(" %s ", $name);
} else {
printf("-> %s ", $name);
}
$first = 1;
}
print(" [weight=1000]\n");
}
print("\n");
# invisible chain of edges between all entities
my $first = 1;
print(" { rank=same;\n edge[style=invis]\n");
foreach my $e (@cfg_entity_arr) {
if ($first) {
printf(" %s0 ", $e);
$first = 0;
} else {
printf("-> %s0 ", $e);
}
}
print("\n }\n");
print("\n");
}
sub entity_left_of($$)
{
my $l = shift;
my $r = shift;
if ($cfg_entities{$l} < $cfg_entities{$r}) {
return 1;
} else {
return 0;
}
}
# generate edges for the individual messages
sub gen_edges()
{
my $count = 1;
foreach my $m (@cfg_messages) {
my $l; my $r; my $dir; my $attr = "";
if (entity_left_of($$m{'src'}, $$m{'dst'})) {
$l = $$m{'src'};
$r = $$m{'dst'};
$dir = 'forward';
} else {
$l = $$m{'dst'};
$r = $$m{'src'};
$dir = 'back';
}
if ($$m{'flags'} =~ /\W+both\W*/) {
$dir = 'both';
}
if ($$m{'flags'} =~ /\W+dashed\W*/) {
$attr .= ' style=dashed';
}
print(" { rank=same;\n");
printf(" %s%u -> %s%u [dir=%s label=\"%s\"%s]\n }\n",
$l, $count, $r, $count, $dir, $$m{'label'}, $attr);
$count++;
}
}
parse_cfg_file($ARGV[0]);
# print static header
print("digraph ladder {\n");
print(" node [shape=point]\n");
print(" edge [dir=none]\n");
# generate and print dynamic content
gen_nodes();
gen_edges();
# print footer
print("}\n");