Road to Cisco ACL Parser(2)
んー、ドキュメント読むのがめんどい。
とりあえず、acl syntax checker の syntax そのまま実装してみるか、ということでつくってみた。この辺、lexer のデータとか自力でやれる気がしないし。まずは使えそうなものを移植して、大本のスケルトンをみてみる、ということで。処理の中身を書いて味付けをする前に基本的な動作とか機能とかをいろいろ見ておかないと確実に破綻しそうな勢い。
ちなみに、IPv6については考慮しない方向で。ややこしくなるので。
# -*- yapp -*- # grammar head section %{ use lib qw(.); use strict; use warnings; use Data::Dumper; use Regexp::Common qw/number net/; %} %tree # Let us build an abstract syntax tree ... # grammar body section %% expr: extended_acl ; extrule_prefix: acl number_extacl dynamic_spec permit_deny ; extended_acl: acl number_extacl REMARK text_remark | extrule_prefix tcp_rule | extrule_prefix udp_rule | extrule_prefix icmp_rule | extrule_prefix noports_rule | extrule_prefix protbynum_rule ; tcp_rule: tcp_proto srcdst_portspec_tcp srcdst_portspec_tcp tcp_flags_list other_qualifier_list ; udp_rule: udp_proto srcdst_portspec_udp srcdst_portspec_udp other_qualifier_list ; icmp_rule: icmp_proto srcdst_noportspec srcdst_noportspec icmp_qualifier other_qualifier_list ; noports_rule: protocol_noports srcdst_noportspec srcdst_noportspec other_qualifier_list ; protbynum_rule: protocol_number srcdst_noportspec srcdst_noportspec other_qualifier_list ; dynamic_spec: # empty | DYNAMIC REMARK_STR timeout_spec ; timeout_spec: # empty | TIMEOUT NUMBER ; text_remark: REMARK_STR ; acl: ACL ; number_extacl: NUMBER ; permit_deny: PERMIT | DENY ; protocol_noports: AH # SET_PROTO(51) | EIGRP # SET_PROTO(88) | ESP # SET_PROTO(50) | GRE # SET_PROTO(47) | IGMP # SET_PROTO(2) | IGRP | IP # SET_PROTO(0) | IPINIP # SET_PROTO(94) | NOS | OSPF # SET_PROTO(89) ; protocol_number: number_proto ; tcp_proto: TCP # SET_PROTO(6) ; udp_proto: UDP # SET_PROTO(17) ; icmp_proto: ICMP # SET_PROTO(1) ; number_proto: NUMBER ; srcdst_noportspec: HOST addr_spec | ANY | ipv4addr ipv4addr ; srcdst_portspec_tcp: HOST addr_spec port_spec_tcp | ANY port_spec_tcp | addr_spec addr_spec port_spec_tcp ; srcdst_portspec_udp: HOST addr_spec port_spec_udp | ANY port_spec_udp | addr_spec addr_spec port_spec_udp ; /* addr_spec is for HOST only */ addr_spec: ipv4addr | LOWER_STR ; ipv4addr: IPV4ADDR ; port_spec_tcp: /* empty port spec */ | unary_portspec port_tcp | RANGE port_tcp port_tcp ; port_spec_udp: /* empty port spec */ | unary_portspec port_udp | RANGE port_udp port_udp ; unary_portspec: GT | EQ | NEQ | LT ; port_tcp_word: BGP | CHARGEN | CMD | DAYTIME | DISCARD | DOMAIN | ECHO | EXEC | FINGER | FTP | FTP_DATA | GOPHER | HOSTNAME | IDENT | IRC | KLOGIN | KSHELL | LOGIN | LPD | NNTP | PIM_AUTO_RP | POP2 | POP3 | SMTP | SUNRPC | SYSLOG | TACACS | TALK | TELNET | TIME | UUCP | WHOIS | WWW ; port_tcp: NUMBER | port_tcp_word ; port_udp_word: BIFF | BOOTPC | BOOTPS | DISCARD | DNSIX | DOMAIN | ECHO | ISAKMP | MOBILE_IP | NAMESERVER | NETBIOS_DGM | NETBIOS_NS | NETBIOS_SS | NTP | PIM_AUTO_RP | RIP | SNMP | SNMPTRAP | SUNRPC | SYSLOG | TACACS | TALK | TFTP | TIME | WHO | XDMCP ; port_udp: NUMBER | port_udp_word ; time_range_spec: TIME_RANGE REMARK_STR ; dscp_spec: NUMBER | AF11 | AF12 | AF13 | AF21 | AF22 | AF23 | AF31 | AF32 | AF33 | AF41 | AF42 | AF43 | CS1 | CS2 | CS3 | CS4 | CS5 | CS6 | CS7 | DEFAULT | EF ; dscp_rule: DSCP dscp_spec ; other_qualifier_list: /* empty */ | other_qualifier_list other_qualifier ; other_qualifier: dscp_rule /* Differentiated services codepoint value */ | FRAGMENTS | logging | tos_qualifier | precedence_qualifier | time_range_spec ; icmp_qualifier: /* empty */ | ADM_PROHIB | ALT_ADDR | CONV_ERR | DOD_HOST_PROHIB | DOD_NET_PROHIB | ECHO | ECHO_REPLY | GEN_PARAM_PROB | HOST_ISOL | MOB_REDIR | NET_REDIR | NET_TOS_REDIR | NET_UNREACH | NET_UNKN | NO_ROOM_OPT | OPT_MISSING | PKT_TOO_BIG | PARAM_PROB | PORT_UNREACH | PREC_UNREACH | PROT_UNREACH | HOST_PREC_UNREACH | HOST_REDIR | HOST_TOS_REDIR | HOST_UNKN | HOST_UNREACH | INFO_REPLY | INFO_REQ | MASK_REPLY | MASK_REQ | REASS_TIMEOUT | REDIR | ROUTER_ADV | ROUTER_SOL | SRC_QUENCH | SRC_ROUTE_FAIL | TIME_EXC | TIME_REPLY | TIME_REQ | TRACERT | TTL_EXC | UNREACH | icmp_numqual ; icmp_numqual: icmp_numtype | icmp_numtype icmp_numcode ; icmp_numtype: NUMBER ; icmp_numcode: NUMBER ; tcp_flags_list: /* empty */ | tcp_flags_list tcp_flag ; ack_flag: ESTABL | ACK ; tcp_flag: ack_flag | SYN | FIN | PSH | URG | RST ; tos_qualifier: TOS tos_string | TOS NUMBER ; tos_string: TOS_MAX_REL | TOS_MAX_THRPUT | TOS_MIN_DELAY | TOS_MIN_MONET_COST | TOS_NORMAL ; precedence_qualifier: PRECEDENCE precedence_string | PRECEDENCE NUMBER ; precedence_string: PREC_CRITICAL | PREC_FLASH | PREC_FLASH_OVERR | PREC_IMMED | PREC_INET | PREC_NET | PREC_PRIO | PREC_ROUTINE ; logging: LOG_INPUT | LOG ; %% # grammar tail section ## Lexer sub yylex { my ($p) = shift; for ( $p->YYData->{INPUT} ) { m/\G\s+/gc; # print "# $_ pos=", pos(), "\n"; # empty m/\G(\s*$)/gc and return ( '', undef ); m/\G(\/)/gc and return ( 'SLASH', $1 ); m/\G(ipv6)/gc and return ( 'IPV6', $1 ); m/\G(access-list)/gc and return ( 'ACL', $1 ); m/\G(permit)/gc and return ( 'PERMIT', $1 ); m/\G(deny)/gc and return ( 'DENY', $1 ); m/\G(remark)/gc and return ( 'REMARK', $1 ); m/\G(dynamic)/gc and return ( 'DYNAMIC', $1 ); m/\G(timeout)/gc and return ( 'TIMEOUT', $1 ); m/\G(icmp)/gc and return ( 'ICMP', $1 ); m/\G(ip)/gc and return ( 'IP', $1 ); m/\G(tcp)/gc and return ( 'TCP', $1 ); m/\G(udp)/gc and return ( 'UDP', $1 ); m/\G(eq)/gc and return ( 'EQ', $1 ); m/\G(neq)/gc and return ( 'NEQ', $1 ); m/\G(gt)/gc and return ( 'GT', $1 ); m/\G(lt)/gc and return ( 'LT', $1 ); m/\G(range)/gc and return ( 'RANGE', $1 ); m/\G(any)/gc and return ( 'ANY', $1 ); m/\G(host)/gc and return ( 'HOST', $1 ); m/\G(established)/gc and return ( 'ESTABL', $1 ); m/\G(syn)/gc and return ( 'SYN', $1 ); m/\G(ack)/gc and return ( 'ACK', $1 ); m/\G(fin)/gc and return ( 'FIN', $1 ); m/\G(psh)/gc and return ( 'PSH', $1 ); m/\G(urg)/gc and return ( 'URG', $1 ); m/\G(rst)/gc and return ( 'RST', $1 ); m/\G(ah)/gc and return ( 'AH', $1 ); m/\G(eigrp)/gc and return ( 'EIGRP', $1 ); m/\G(esp)/gc and return ( 'ESP', $1 ); m/\G(gre)/gc and return ( 'GRE', $1 ); m/\G(igmp)/gc and return ( 'IGMP', $1 ); m/\G(igrp)/gc and return ( 'IGRP', $1 ); m/\G(ip)/gc and return ( 'IP', $1 ); m/\G(ipinip)/gc and return ( 'IPINIP', $1 ); m/\G(nos)/gc and return ( 'NOS', $1 ); m/\G(ospf)/gc and return ( 'OSPF', $1 ); m/\G(dscp)/gc and return ( 'DSCP', $1 ); m/\G(fragments)/gc and return ( 'FRAGMENTS', $1 ); m/\G(log-input)/gc and return ( 'LOG_INPUT', $1 ); m/\G(log-update)/gc and return ( 'LOG_UPDATE', $1 ); m/\G(log)/gc and return ( 'LOG', $1 ); m/\G(threshold)/gc and return ( 'THRESHOLD', $1 ); m/\G(precedence)/gc and return ( 'PRECEDENCE', $1 ); m/\G(time-range)/gc and return ( 'TIME_RANGE', $1 ); m/\G(tos)/gc and return ( 'TOS', $1 ); m/\G(administratively-prohibited)/gc and return ( 'ADM_PROHIB', $1 ); m/\G(alternate-address)/gc and return ( 'ALT_ADDR', $1 ); m/\G(conversion-error)/gc and return ( 'CONV_ERR', $1 ); m/\G(dod-host-prohibited)/gc and return ( 'DOD_HOST_PROHIB', $1 ); m/\G(dod-net-prohibited)/gc and return ( 'DOD_NET_PROHIB', $1 ); m/\G(echo)/gc and return ( 'ECHO', $1 ); m/\G(echo-reply)/gc and return ( 'ECHO_REPLY', $1 ); m/\G(general-parameter-problem)/gc and return ( 'GEN_PARAM_PROB', $1 ); m/\G(host-isolated)/gc and return ( 'HOST_ISOL', $1 ); m/\G(mobile-redirect)/gc and return ( 'MOB_REDIR', $1 ); m/\G(net-redirect)/gc and return ( 'NET_REDIR', $1 ); m/\G(net-tos-redirect)/gc and return ( 'NET_TOS_REDIR', $1 ); m/\G(net-unreachable)/gc and return ( 'NET_UNREACH', $1 ); m/\G(network-unknown)/gc and return ( 'NET_UNKN', $1 ); m/\G(no-room-for-option)/gc and return ( 'NO_ROOM_OPT', $1 ); m/\G(option-missing)/gc and return ( 'OPT_MISSING', $1 ); m/\G(packet-too-big)/gc and return ( 'PKT_TOO_BIG', $1 ); m/\G(parameter-problem)/gc and return ( 'PARAM_PROB', $1 ); m/\G(port-unreachable)/gc and return ( 'PORT_UNREACH', $1 ); m/\G(precedence-unreachable)/gc and return ( 'PREC_UNREACH', $1 ); m/\G(protocol-unreachable)/gc and return ( 'PROT_UNREACH', $1 ); m/\G(host-precedence-unreachable)/gc and return ( 'HOST_PREC_UNREACH', $1 ); m/\G(host-redirect)/gc and return ( 'HOST_REDIR', $1 ); m/\G(host-tos-redirect)/gc and return ( 'HOST_TOS_REDIR', $1 ); m/\G(host-unknown)/gc and return ( 'HOST_UNKN', $1 ); m/\G(host-unreachable)/gc and return ( 'HOST_UNREACH', $1 ); m/\G(information-reply)/gc and return ( 'INFO_REPLY', $1 ); m/\G(information-request)/gc and return ( 'INFO_REQ', $1 ); m/\G(mask-reply)/gc and return ( 'MASK_REPLY', $1 ); m/\G(mask-request)/gc and return ( 'MASK_REQ', $1 ); m/\G(reassembly-timeout)/gc and return ( 'REASS_TIMEOUT', $1 ); m/\G(redirect)/gc and return ( 'REDIR', $1 ); m/\G(router-advertisement)/gc and return ( 'ROUTER_ADV', $1 ); m/\G(router-solicitation)/gc and return ( 'ROUTER_SOL', $1 ); m/\G(source-quench)/gc and return ( 'SRC_QUENCH', $1 ); m/\G(source-route-failed)/gc and return ( 'SRC_ROUTE_FAIL', $1 ); m/\G(time-exceeded)/gc and return ( 'TIME_EXC', $1 ); m/\G(timestamp-reply)/gc and return ( 'TIME_REPLY', $1 ); m/\G(timestamp-request)/gc and return ( 'TIME_REQ', $1 ); m/\G(traceroute)/gc and return ( 'TRACERT', $1 ); m/\G(ttl-exceeded)/gc and return ( 'TTL_EXC', $1 ); m/\G(unreachable)/gc and return ( 'UNREACH', $1 ); m/\G(beyond-scope)/gc and return ( 'BEYOND_SCOPE', $1 ); m/\G(destination-unreachable)/gc and return ( 'DEST_UNREACH', $1 ); m/\G(echo-request)/gc and return ( 'ECHO_REQUEST', $1 ); m/\G(flow-label)/gc and return ( 'FLOW_LABEL', $1 ); m/\G(header)/gc and return ( 'HEADER', $1 ); m/\G(hop-limit)/gc and return ( 'HOP_LIMIT', $1 ); m/\G(mld-query)/gc and return ( 'MLD_QUERY', $1 ); m/\G(mld-reduction)/gc and return ( 'MLD_REDUCTION', $1 ); m/\G(mld-report)/gc and return ( 'MLD_REPORT', $1 ); m/\G(nd-na)/gc and return ( 'ND_NA', $1 ); m/\G(nd-ns)/gc and return ( 'ND_NS', $1 ); m/\G(next-header)/gc and return ( 'NEXT_HEADER', $1 ); m/\G(no-admin)/gc and return ( 'NO_ADMIN', $1 ); m/\G(no-route)/gc and return ( 'NO_ROUTE', $1 ); m/\G(packet-too-big)/gc and return ( 'PKT_TOO_BIG', $1 ); m/\G(parameter-option)/gc and return ( 'PARAM_OPTION', $1 ); m/\G(parameter-problem)/gc and return ( 'PARAM_PROB', $1 ); m/\G(port-unreachable)/gc and return ( 'PORT_UNREACH', $1 ); m/\G(reassembly-timeout)/gc and return ( 'REASS_TIMEOUT', $1 ); m/\G(renum-command)/gc and return ( 'RENUM_CMD', $1 ); m/\G(renum-result)/gc and return ( 'RENUM_RES', $1 ); m/\G(renum-seq-number)/gc and return ( 'RENUM_SEQ_NR', $1 ); m/\G(router-advertisement)/gc and return ( 'ROUTER_ADV', $1 ); m/\G(router-renumbering)/gc and return ( 'ROUTER_RENUM', $1 ); m/\G(router-solicitation)/gc and return ( 'ROUTER_SOL', $1 ); m/\G(routing)/gc and return ( 'ROUTING', $1 ); m/\G(undetermined-transport)/gc and return ( 'UNDET_TRAN', $1 ); m/\G(sequence)/gc and return ( 'SEQUENCE', $1 ); m/\G(time-exceeded)/gc and return ( 'TIME_EXCEED', $1 ); m/\G(precedence)/gc and return ( 'PRECEDENCE', $1 ); m/\G(critical)/gc and return ( 'PREC_CRITICAL', $1 ); m/\G(flash)/gc and return ( 'PREC_FLASH', $1 ); m/\G(flash-override)/gc and return ( 'PREC_FLASH_OVERR', $1 ); m/\G(immediate)/gc and return ( 'PREC_IMMED', $1 ); m/\G(internet)/gc and return ( 'PREC_INET', $1 ); m/\G(network)/gc and return ( 'PREC_NET', $1 ); m/\G(priority)/gc and return ( 'PREC_PRIO', $1 ); m/\G(routine)/gc and return ( 'PREC_ROUTINE', $1 ); m/\G(reflect)/gc and return ( 'REFLECT', $1 ); m/\G(tos)/gc and return ( 'TOS', $1 ); m/\G(max-reliability)/gc and return ( 'TOS_MAX_REL', $1 ); m/\G(max-throughput)/gc and return ( 'TOS_MAX_THRPUT', $1 ); m/\G(min-delay)/gc and return ( 'TOS_MIN_DELAY', $1 ); m/\G(min-monetary-cost)/gc and return ( 'TOS_MIN_MONET_COST', $1 ); m/\G(normal)/gc and return ( 'TOS_NORMAL', $1 ); m/\G(bgp)/gc and return ( 'BGP', $1 ); m/\G(chargen)/gc and return ( 'CHARGEN', $1 ); m/\G(cmd)/gc and return ( 'CMD', $1 ); m/\G(daytime)/gc and return ( 'DAYTIME', $1 ); m/\G(discard)/gc and return ( 'DISCARD', $1 ); m/\G(domain)/gc and return ( 'DOMAIN', $1 ); m/\G(echo)/gc and return ( 'ECHO', $1 ); m/\G(exec)/gc and return ( 'EXEC', $1 ); m/\G(finger)/gc and return ( 'FINGER', $1 ); m/\G(ftp)/gc and return ( 'FTP', $1 ); m/\G(ftp-data)/gc and return ( 'FTP_DATA', $1 ); m/\G(gopher)/gc and return ( 'GOPHER', $1 ); m/\G(hostname)/gc and return ( 'HOSTNAME', $1 ); m/\G(ident)/gc and return ( 'IDENT', $1 ); m/\G(irc)/gc and return ( 'IRC', $1 ); m/\G(klogin)/gc and return ( 'KSHELL', $1 ); m/\G(login)/gc and return ( 'LOGIN', $1 ); m/\G(lpd)/gc and return ( 'LPD', $1 ); m/\G(nntp)/gc and return ( 'NNTP', $1 ); m/\G(pim-auto-rp)/gc and return ( 'PIM_AUTO_RP', $1 ); m/\G(pop2)/gc and return ( 'POP2', $1 ); m/\G(pop3)/gc and return ( 'POP3', $1 ); m/\G(smtp)/gc and return ( 'SMTP', $1 ); m/\G(sunrpc)/gc and return ( 'SUNRPC', $1 ); m/\G(syslog)/gc and return ( 'SYSLOG', $1 ); m/\G(tacacs)/gc and return ( 'TACACS', $1 ); m/\G(talk)/gc and return ( 'TALK', $1 ); m/\G(telnet)/gc and return ( 'TELNET', $1 ); m/\G(time)/gc and return ( 'TIME', $1 ); m/\G(uucp)/gc and return ( 'UUCP', $1 ); m/\G(whois)/gc and return ( 'WHOIS', $1 ); m/\G(www)/gc and return ( 'WWW', $1 ); m/\G(biff)/gc and return ( 'BIFF', $1 ); m/\G(bootpc)/gc and return ( 'BOOTPC', $1 ); m/\G(bootps)/gc and return ( 'BOOTPS', $1 ); m/\G(dnsix)/gc and return ( 'DNSIX', $1 ); m/\G(echo)/gc and return ( 'ECHO', $1 ); m/\G(isakmp)/gc and return ( 'ISAKMP', $1 ); m/\G(mobile-ip)/gc and return ( 'MOBILE_IP', $1 ); m/\G(nameserver)/gc and return ( 'NAMESERVER', $1 ); m/\G(netbios-dgm)/gc and return ( 'NETBIOS_DGM', $1 ); m/\G(netbios-ns)/gc and return ( 'NETBIOS_NS', $1 ); m/\G(netbios-ss)/gc and return ( 'NETBIOS_SS', $1 ); m/\G(ntp)/gc and return ( 'NTP', $1 ); m/\G(pim-auto-rp)/gc and return ( 'PIM_AUTO_RP', $1 ); m/\G(rip)/gc and return ( 'RIP', $1 ); m/\G(snmp)/gc and return ( 'SNMP', $1 ); m/\G(snmptrap)/gc and return ( 'SNMPTRAP', $1 ); m/\G(sunrpc)/gc and return ( 'SUNRPC', $1 ); m/\G(syslog)/gc and return ( 'SYSLOG', $1 ); m/\G(talk)/gc and return ( 'TALK', $1 ); m/\G(tftp)/gc and return ( 'TFTP', $1 ); m/\G(time)/gc and return ( 'TIME', $1 ); m/\G(who)/gc and return ( 'WHO', $1 ); m/\G(xdmcp)/gc and return ( 'XDMCP', $1 ); m/\G(af11)/gc and return ( 'AF11', $1 ); m/\G(af12)/gc and return ( 'AF12', $1 ); m/\G(af13)/gc and return ( 'AF13', $1 ); m/\G(af21)/gc and return ( 'AF21', $1 ); m/\G(af22)/gc and return ( 'AF22', $1 ); m/\G(af23)/gc and return ( 'AF23', $1 ); m/\G(af31)/gc and return ( 'AF31', $1 ); m/\G(af32)/gc and return ( 'AF32', $1 ); m/\G(af33)/gc and return ( 'AF33', $1 ); m/\G(af41)/gc and return ( 'AF41', $1 ); m/\G(af42)/gc and return ( 'AF42', $1 ); m/\G(af43)/gc and return ( 'AF43', $1 ); m/\G(cs1)/gc and return ( 'CS1', $1 ); m/\G(cs2)/gc and return ( 'CS2', $1 ); m/\G(cs3)/gc and return ( 'CS3', $1 ); m/\G(cs4)/gc and return ( 'CS4', $1 ); m/\G(cs5)/gc and return ( 'CS5', $1 ); m/\G(cs6)/gc and return ( 'CS6', $1 ); m/\G(cs7)/gc and return ( 'CS7', $1 ); m/\G(default)/gc and return ( 'DEFAULT', $1 ); m/\G(ef)/gc and return ( 'EF', $1 ); m/\G($RE{net}{IPv4}{dec})/gc and return ( 'IPV4ADDR', $1 ); m/\G($RE{num}{int}{-keep})/gc and return ( 'NUMBER', $1 ); m/\G([a-z0-9\-\.]*)/gc and return ( 'LOWER_STR', $1 ); m/\G([A-Za-z()0-9,\'_=\-]*)/gc and return ( 'REMARK_STR', $1 ); } return ( '', undef ); } ## Error Handler sub yyerror { die "Syntax error near " . ( $_[0]->YYCurval ? $_[0]->YYCurval : "end of file" ) . "\n"; } ## main Routine sub run { my $self = shift; $self->YYParse( yylex => \&yylex, yyerror => \&yyerror, # yydebug => 0x01, ); }
# -*- cperl -*- use lib qw(.); use strict; use warnings; use Parse::Eyapp; use Data::Dumper; use AclParser; #sub TERMINAL::info { $_[0]{attr} } my $aclparser = AclParser->new(); print "? "; while (<>) { last if m{^q(?:uit)?}; $aclparser->YYData->{INPUT} = $_; my $t; eval { $t = $aclparser->run(); }; if ($@) { warn $@; } else { print $t->str; } print "\n? "; }
実行例
$ perl paclcheck.pl ? access-list 103 permit tcp 192.168.253.0 255.255.255.128 gt 1023 host 192.168.0.34 eq 53 expr_1(extended_acl_4(extrule_prefix_2(acl_19(TERMINAL),number_extacl_20(TERMINAL),dynamic_spec_14,permit_deny_21(TERMINAL)),tcp_rule_9(tcp_proto_34(TERMINAL),srcdst_portspec_tcp_43(addr_spec_47(ipv4addr_49(TERMINAL)),addr_spec_47(ipv4addr_49(TERMINAL)),port_spec_tcp_51(unary_portspec_56(TERMINAL),port_tcp_93(TERMINAL))),srcdst_portspec_tcp_41(TERMINAL,addr_spec_47(ipv4addr_49(TERMINAL)),port_spec_tcp_51(unary_portspec_57(TERMINAL),port_tcp_93(TERMINAL))),tcp_flags_list_203,other_qualifier_list_147))) ?
とりあえず動くことは動くが、テストをちゃんとやったわけではないので、信頼性はない。
テストについてはまだ全く考慮していない。先にテスト項目とテストデータを用意した方がよいのかもしれないが、まあ面倒なので後回し。どうせやるなら Test::Simple とかの使い方をちゃんと覚えたいというのもある。その辺覚えないでテスト用意しても使い回し効かなくて無駄になりそうな気がするしな。
syntax tree を Graphviz::Parse::Yapp で作り直してみた。当然前に自前で作ったのと中身は同じなのだけど、こっちのがどういう感じの図が出てくるのか試しておきたかったので。