commit d15f745e78985e5677b797fd69c5275bd5c5ed61 from: Izzy Blacklock date: Sat Aug 12 20:09:29 2023 UTC Imported account related DNS subs from BotNow::DNS.pm Added use of carp instaed of die and better debug messages in places created bin/dnsTest.pl as a test/example script of using the functions in IRCNOW::Acct::DNS. Currently confirmed nextdns() works. Still need to work on pod documents and confirm the rest of the subs work. cliNow.pl was used as a base for dnsTest.pl and a copy of it made into ircTest.pl for the tests related to the IRC module. commit - 27bfd2c38619a7c831b1fd4f42fda665aa0d8d9e commit + d15f745e78985e5677b797fd69c5275bd5c5ed61 blob - a5adf897916a4e983103004c327023809f1eda4b blob + 477a6714b33871d20c56e6f87ac098c46cff12f3 --- bin/cliNow.pl +++ bin/cliNow.pl @@ -8,7 +8,7 @@ use lib qw(./lib); use IRCNOW::Database; use IRCNOW::IO::IRC; -use IRCNOW::Acct; +use IRCNOW::Acct::DNS; use IRCNOW::IO qw(:DEBUG); @@ -22,18 +22,4 @@ use Data::Dumper; #my $acct=new IRCNOW::Acct(); #print $acct->newpass() . "\n"; -my $irc = new IRCNOW::IO::IRC( - localnet => 'ircnow', - staff => 'izzyb', - nick => 'cliNow', - host => '127.0.0.1', - port => 6667, - pass => 'secret', - expires => 1800, - networks => 'ircnow', - chans => '#bottest', - teamchans => '', -); -$irc->run(); - blob - /dev/null blob + 51099211f36246a4e0ae6e89e847f95783b93ddf (mode 755) --- /dev/null +++ bin/dnsTest.pl @@ -0,0 +1,62 @@ +#!/usr/bin/perl +# + +use strict; +use warnings; +#use OpenBSD::Pledge; +#use OpenBSD::Unveil; + +use lib qw(./lib); +use IRCNOW::Database; + +use IRCNOW::IO::IRC; +use IRCNOW::Acct::DNS; + + +# Load debug modules and set path for auto backups. +use IRCNOW::IO qw(:DEBUG); +$verbosity=ALL; # verbosity is exported via :DEBUG sets the debug level +$IRCNOW::IO::backupspath = 'zones/'; + +#my $dbase='/var/www/botnow/botnow.db'; +#debug(INFO, "Loading Database $dbase"); +#my $botnowDB = IRCNOW::Database->new(dbpath=>$dbase); + +use Data::Dumper; + +#my $acct=new IRCNOW::Acct(); +#print $acct->newpass() . "\n"; + +my $dnsAcct=new IRCNOW::Acct::DNS(); +$dnsAcct->init(); +#unveil() or die "Unable to lock unveil $!"; + +$dnsAcct->nextdns('izzyb'); + + +=pod + +=head1 NAME + +bin/dnsTest.pl + +=head1 SYNOPSIS + +#!/usr/bin/perl +use strict; +use warnings; + +# Load debug modules and set path for auto backups. +use IRCNOW::IO qw(:DEBUG :FILEIO); +$verbosity=ALL; # verbosity is exported via :DEBUG sets the debug level +$IRCNOW::IO::backupspath = 'zones/'; + +# DNS commands related to IRCNOW accounts. +use IRCNOW::Acct::DNS; + +=head1 DESCRIPTION + +This script provides example usage of the IRCNOW::Acct::DNS module. + +=cut + blob - /dev/null blob + a5adf897916a4e983103004c327023809f1eda4b (mode 755) --- /dev/null +++ bin/ircTest.pl @@ -0,0 +1,39 @@ +#!/usr/bin/perl +# + +use strict; +use warnings; + +use lib qw(./lib); +use IRCNOW::Database; + +use IRCNOW::IO::IRC; +use IRCNOW::Acct; + + +use IRCNOW::IO qw(:DEBUG); +$verbosity=ALL; +#my $dbase='/var/www/botnow/botnow.db'; +#debug(INFO, "Loading Database $dbase"); +#my $botnowDB = IRCNOW::Database->new(dbpath=>$dbase); + +use Data::Dumper; + +#my $acct=new IRCNOW::Acct(); +#print $acct->newpass() . "\n"; + +my $irc = new IRCNOW::IO::IRC( + localnet => 'ircnow', + staff => 'izzyb', + nick => 'cliNow', + host => '127.0.0.1', + port => 6667, + pass => 'secret', + expires => 1800, + networks => 'ircnow', + chans => '#bottest', + teamchans => '', +); + +$irc->run(); + blob - 87f37ddfb4ad05db8b3015fc376edc2eeabae6e4 blob + 91dae8a4dc2e7e0e1a5166a7b9fad5b50a203b41 --- lib/IRCNOW/Acct/DNS.pm +++ lib/IRCNOW/Acct/DNS.pm @@ -2,33 +2,68 @@ package IRCNOW::Acct::DNS; use strict; use warnings; -use OpenBSD::Pledge; -use OpenBSD::Unveil; +use Carp; +#use OpenBSD::Pledge; +#use OpenBSD::Unveil; use lib qw(./lib); -use IRCNOW::IO qw(readarray writefile appendfile); +use IRCNOW::IO qw(:DEBUG readarray writefile appendfile); use File::Copy qw(copy); -my %conf = %main::conf; -my $chans = $conf{chans}; -my $staff = $conf{staff}; -my $key = $conf{key}; -my $hash = $conf{hash}; -my $hostname = $conf{hostname}; -my $verbose = $conf{verbose}; -my $ip4 = $conf{ip4}; -my $ip6 = $conf{ip6}; -my $ip6subnet = $conf{ip6subnet}; -my $zonedir = $conf{zonedir}; -my $hostnameif = $conf{hostnameif}; -if (host($hostname) =~ /(\d+\.){3,}\d+/) { - $ip4 = $&; + +# Global vars needed by this library can be passed via this +# packages global $conf var if not using the OOP interface. +# Calling libraries should set a local var to this packages +# config hash like this: +# +# my $dnsConf=$IRCNOW::Acct::DNS::conf; +# +# Changes can be made as needed before calling functions then. +# In OOP mode, $self is set using $conf in new(); +our $conf = { + hostname => undef, + hostnameif => "hostname.vio0", + ip4 => undef, + ip6 => undef, + ip6subnet => 48, + zonedir => 'zones', +}; + + +sub verifyConf { + my $self = shift || $conf; + + if (not defined $self->{hostname}) { + $self->{hostname} = `hostname`; # default to system call for hostname + chomp($self->{hostname}); + } + if (not defined $self->{ip4} or not defined $self->{ip6}) { + ($self->{ip4}, $self->{ip6}) = split (" ", host($self->{hostname})) + } } + +sub new { + my ($class,%options) = @_; + my $self=$conf; #us defaults from global + + # Copy needed passed params + for my $param (qw{ hostname hostnameif ip4 ip6 ip6subnet zonedir }) { + $self->{$param} = $options{$param} if (exists $options{$param}); + } + + bless $self, $class; + + $self->verifyConf(); + + return $self; +} + sub init { - unveil("$zonedir", "rwc") or die "Unable to unveil $!"; - unveil("/usr/bin/doas", "rx") or die "Unable to unveil $!"; - unveil("/usr/bin/host", "rx") or die "Unable to unveil $!"; - unveil("$hostnameif", "rwc") or die "Unable to unveil $!"; + my $self= shift || $conf; + # unveil($self->{zonedir}, "rwc") or die "Unable to unveil $!"; + # unveil("/usr/bin/doas", "rx") or die "Unable to unveil $!"; + # unveil("/usr/bin/host", "rx") or die "Unable to unveil $!"; + # unveil($self->{hostnameif}, "rwc") or die "Unable to unveil $!"; } # Return list of ipv6 addresses from filename @@ -46,6 +81,7 @@ sub readip6s { return @ipv6s; } + # set rdns of $ip6 to $hostname given $subnet # return true on success; false on failure sub setrdns { @@ -71,8 +107,16 @@ sub delrdns { # if $value is missing, delete $domain # returns true upon success, false upon failure sub setdns { + my $self = shift; + # Verify we were called in object mode or return $self to the param list + if (not UNIVERSAL::isa($self, 'IRCNOW::Acct::DNS')) { + unshift @_, $self; + $self = $conf; + } + my ($name, $origin, $type, $value) = @_; - my $filename = "$zonedir/$origin"; + debug(ALL,"SUB: setdns($name, $origin, $type, $value)"); + my $filename = $self->{zonedir} ."/$origin"; my @lines = readarray($filename); foreach my $line (@lines) { # increment the zone's serial number @@ -89,8 +133,8 @@ sub setdns { push(@lines, "$name 3600 IN $type $value"); } # trailing newline necessary - writefile("$filename.bak", join("\n", @lines)."\n"); - copy "$filename.bak", $filename; + writefile("$filename", join("\n", @lines)."\n"); + debug(ALL, 'Running: doas -u _nsd nsd-control reload'); if (system("doas -u _nsd nsd-control reload")) { return 0; } else { @@ -137,21 +181,23 @@ sub ip6full { # Returns the network part of the first IPv6 address (indicated by subnet) # with the host part of the second IPv6 address sub ip6mask { - my ($ip6net, $subnet, $ip6host) = @_; - my $netdigits = ip6full($ip6net); - $netdigits =~ tr/://d; - my $hostdigits = ip6full($ip6host); - $hostdigits =~ tr/://d; - my $digits = substr($netdigits,0,($subnet/4)).substr($hostdigits,($subnet/4)); - my $ip6; - for (my $n = 0; $n < 32; $n++) { - if ($n > 0 && $n % 4 == 0) { - $ip6 .= ":"; - } - $ip6 .= substr($digits,$n,1); - } - return $ip6; + my ($ip6net, $subnet, $ip6host) = @_; + my $netdigits = ip6full($ip6net); + $netdigits =~ tr/://d; + my $hostdigits = ip6full($ip6host); + $hostdigits =~ tr/://d; + my $digits = substr($netdigits,0,($subnet/4)).substr($hostdigits,($subnet/4)); + my $ip6; + for (my $n = 0; $n < 32; $n++) { + if ($n > 0 && $n % 4 == 0) { + $ip6 .= ":"; + } + $ip6 .= substr($digits,$n,1); + } + return $ip6; } + + sub randip6 { return join ':', map { sprintf '%04x', rand 0x10000 } (1 .. 8); } @@ -159,15 +205,25 @@ sub randip6 { # create A and AAAA records for subdomain, set the rDNS, # and return the new ipv6 address sub nextdns { + my $self = shift; + # Verify we were called in object mode or return $self to the param list + if (not UNIVERSAL::isa($self, 'IRCNOW::Acct::DNS')) { + unshift @_, $self; + $self = $conf; + } + my ($subdomain) = @_; - my $newip6 = $ip6; - my @allip6s = readip6s($hostnameif); + my $newip6 = $self->{ip6}; + my @allip6s = readip6s($self->{hostnameif}); while (grep(/$newip6/, @allip6s)) { - $newip6 = ip6mask($ip6, $ip6subnet,randip6()); + $newip6 = ip6mask($self->{ip6}, $self->{ip6subnet},randip6()); } - appendfile($hostnameif, "inet6 alias $newip6 48\n"); + appendfile($self->{hostnameif}, "inet6 alias $newip6 48\n"); + # activate new ip as an alias `doas ifconfig vio0 inet6 $newip6/48`; - if (setdns($subdomain, $hostname, "A", $ip4) && setdns($subdomain, $hostname, "AAAA", $newip6) && setrdns($newip6, $ip6subnet, "$subdomain.$hostname")) { + if (setdns($subdomain, $self->{hostname}, "A", $self->{ip4}) + && setdns($subdomain, $self->{hostname}, "AAAA", $newip6) + && setrdns($newip6, $self->{ip6subnet}, "$subdomain." . $self->{hostname})) { return "$newip6"; } return "false"; blob - 168758b950c0800feb0cee47239e4e1d5bceab38 blob + 01042fc74779dccdcd0d41343dd48b45dc84c389 --- lib/IRCNOW/IO.pm +++ lib/IRCNOW/IO.pm @@ -1,7 +1,7 @@ package IRCNOW::IO; use strict; use warnings; - +use Carp; use Exporter 'import'; our @EXPORT_OK = qw( @@ -72,7 +72,7 @@ sub verbosity2const { # Read from filename and return array of lines without trailing newlines sub readarray { my ($filename) = @_; - open(my $fh, '<', $filename) or die "Could not read file '$filename' $!"; + open(my $fh, '<', $filename) or carp "Could not read file '$filename' $!"; chomp(my @lines = <$fh>); close $fh; return @lines; @@ -81,7 +81,7 @@ sub readarray { # Read from filename and return as string sub readstr { my ($filename) = @_; - open(my $fh, '<', $filename) or die "Could not read file '$filename' $!"; + open(my $fh, '<', $filename) or carp "Could not read file '$filename' $!"; my $str = do { local $/; <$fh> }; close $fh; return $str; @@ -91,8 +91,8 @@ sub readstr { sub writefile { my ($filename, $str) = @_; my $date = date(); - copy($filename, $backupspath.basename($filename).".".date()) or die "Could not make backup of $filename"; - open(my $fh, '>', "$filename") or die "Could not write to $filename"; + copy($filename, $backupspath.basename($filename).".".date()) or carp "Could not make backup of $filename - $!"; + open(my $fh, '>', "$filename") or carp "Could not write to $filename"; print $fh $str; close $fh; } @@ -100,7 +100,7 @@ sub writefile { # Append str to filename sub appendfile { my ($filename, $str) = @_; - open(my $fh, '>>', "$filename") or die "Could not append to $filename"; + open(my $fh, '>>', "$filename") or carp "Could not append to $filename"; print $fh $str; close $fh; } @@ -142,7 +142,7 @@ Content-Disposition: inline $body EOF -open(my $fh, "| /usr/sbin/sendmail -tv -F '$fromname' -f $from") or die "Could not send mail $!"; +open(my $fh, "| /usr/sbin/sendmail -tv -F '$fromname' -f $from") or carp "Could not send mail $!"; print $fh $msg; close $fh; return "true";