- fix Mason profiling to pass-through images (for graph/)
[freeside.git] / bin / bind.export
1 #!/usr/bin/perl -w
2
3 use strict;
4 use File::Path;
5 use File::Rsync;
6 use Net::SSH qw(ssh);
7 use FS::UID qw(adminsuidsetup datasrc);
8 use FS::Record qw(qsearch qsearchs);
9 use FS::part_export;
10 use FS::cust_pkg;
11 use FS::cust_svc;
12 use FS::svc_domain;
13
14 my $user = shift or die &usage;
15 adminsuidsetup $user;
16
17 my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/bind";
18 mkdir $spooldir, 0700 unless -d $spooldir;
19
20 my @exports = qsearch('part_export', { 'exporttype' => 'bind' } );
21 my @sexports = qsearch('part_export', { 'exporttype' => 'bind_slave' } );
22
23 my $rsync = File::Rsync->new({
24   rsh     => 'ssh',
25 #  dry_run => 1,
26 });
27
28 foreach my $export ( @exports ) {
29
30   my $machine = $export->machine;
31   my $prefix = "$spooldir/$machine";
32
33   my $bind_rel = $export->option('bind_release');
34   my $ndc_cmd = ($bind_rel eq 'BIND9') ? 'rndc' : 'ndc';
35   my $minttl = $export->option('bind9_minttl');
36
37   #prevent old domain files from piling up
38   #rmtree "$prefix" or die "can't rmtree $prefix.db: $!";
39
40   mkdir $prefix, 0700 unless -d $prefix;
41
42   open(NAMED_CONF,">$prefix/named.conf")
43     or die "can't open $prefix/named.conf: $!";
44
45   open(CONF_HEADER,"<$prefix/named.conf.HEADER")
46     or die "can't open $prefix/named.conf.HEADER: $!";
47   while (<CONF_HEADER>) { print NAMED_CONF $_; }
48   close CONF_HEADER;
49
50   my $zonepath = $export->option('zonepath');
51   $zonepath =~ s/\/$//;
52
53   my @svc_domain = $export->svc_x;
54
55   foreach my $svc_domain ( @svc_domain ) {
56     my $domain = $svc_domain->domain;
57     my @masters = qsearch('domain_record', {
58       'svcnum' => $svc_domain->svcnum,
59       'rectype' => '_mstr',
60     } );
61     if ( @masters ) {
62       my $masters = join('; ', map { $_->recdata } @masters );
63
64       print NAMED_CONF <<END;
65 zone "$domain" {
66         type slave;
67         file "db.$domain";
68         masters { $masters; };
69 };
70
71 END
72
73     } else {
74
75       print NAMED_CONF <<END;
76 zone "$domain" {
77         type master;
78         file "$zonepath/db.$domain";
79 };
80
81 END
82
83       open (DB_MASTER,">$prefix/db.$domain")
84         or die "can't open $prefix/db.$domain: $!";
85
86       if ($bind_rel eq 'BIND9') {
87         print DB_MASTER "\$TTL $minttl\n\$ORIGIN $domain.\n";
88       }
89
90       my @domain_records =
91         qsearch('domain_record', { 'svcnum' => $svc_domain->svcnum } );
92       foreach my $domain_record (
93         sort { $b->rectype cmp $a->rectype } @domain_records
94       ) {
95         #if ( $domain_record->rectype eq 'SOA' ) {
96         #  print DB_MASTER join("\t", $domain_record-> reczone
97         #} else {
98           print DB_MASTER join("\t",
99             map { $domain_record->getfield($_) }
100               qw( reczone recaf rectype recdata )
101           ), "\n";
102         #}
103       }
104
105       close DB_MASTER;
106
107     }
108
109   }
110
111   $rsync->exec( {
112     src       => "$prefix/",
113     recursive => 1,
114     dest      => "root\@$machine:$zonepath/",
115     exclude   => [qw( *.import named.conf.HEADER named.conf )],
116   } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
117  # warn $rsync->out;
118
119   $rsync->exec( {
120     src     => "$prefix/named.conf",
121     dest    => "root\@$machine:". $export->option('named_conf'),
122   } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
123 #  warn $rsync->out;
124
125   ssh("root\@$machine", "$ndc_cmd reload");
126
127 }
128
129 close NAMED_CONF;
130
131 foreach my $sexport ( @sexports ) { #false laziness with above
132
133   my $machine = $sexport->machine;
134   my $prefix = "$spooldir/$machine";
135
136   my $bind_rel = $sexport->option('bind_release');
137   my $ndc_cmd = ($bind_rel eq 'BIND9') ? 'rndc' : 'ndc';
138
139   #prevent old domain files from piling up
140   #rmtree "$prefix" or die "can't rmtree $prefix.db: $!";
141
142   mkdir $prefix, 0700 unless -d $prefix;
143
144   open(NAMED_CONF,">$prefix/named.conf")
145     or die "can't open $prefix/named.conf: $!";
146
147   open(CONF_HEADER,"<$prefix/named.conf.HEADER")
148     or die "can't open $prefix/named.conf.HEADER: $!";
149   while (<CONF_HEADER>) { print NAMED_CONF $_; }
150   close CONF_HEADER;
151
152   my $masters = $sexport->option('master');
153
154   #false laziness with  freeside-sqlradius-reset 
155   my @svc_domain =
156     map { qsearchs('svc_domain', { 'svcnum' => $_->svcnum } ) }
157       map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
158         grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
159           $sexport->export_svc;
160
161   foreach my $svc_domain ( @svc_domain ) {
162     my $domain = $svc_domain->domain;
163     print NAMED_CONF <<END;
164 zone "$domain" {
165         type slave;
166         file "db.$domain";
167         masters { $masters; };
168 };
169
170 END
171
172   }
173
174   $rsync->exec( {
175     src     => "$prefix/named.conf",
176     dest    => "root\@$machine:". $sexport->option('named_conf'),
177   } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
178 #  warn $rsync->out;
179
180   ssh("root\@$machine", "$ndc_cmd reload");
181
182 }
183 close NAMED_CONF;
184
185 # -----
186
187 sub usage {
188   die "Usage:\n  bind.export user\n"; 
189 }
190