1package Net::DNS::Resolver::os390;
2
3use strict;
4use warnings;
5our $VERSION = (qw$Id: os390.pm 1811 2020-10-05 08:24:23Z willem $)[2];
6
7
8=head1 NAME
9
10Net::DNS::Resolver::os390 - IBM OS/390 resolver class
11
12=cut
13
14
15use base qw(Net::DNS::Resolver::Base);
16use IO::File;
17
18local $ENV{PATH} = join ':', grep {$_} qw(/bin /usr/bin), $ENV{PATH};
19my $sysname = eval {`sysvar SYSNAME 2>/dev/null`} || '';
20chomp $sysname;
21
22
23my %RESOLVER_SETUP;			## placeholders for unimplemented search list elements
24
25my @dataset = (				## plausible places to seek resolver configuration
26	$RESOLVER_SETUP{GLOBALTCPIPDATA},
27	$ENV{RESOLVER_CONFIG},					# MVS dataset or Unix file name
28	"/etc/resolv.conf",
29	$RESOLVER_SETUP{SYSTCPD},
30	"//TCPIP.DATA",						# <username>.TCPIP.DATA
31	"//'${sysname}.TCPPARMS(TCPDATA)'",
32	"//'SYS1.TCPPARMS(TCPDATA)'",
33	$RESOLVER_SETUP{DEFAULTTCPIPDATA},
34	"//'TCPIP.TCPIP.DATA'"
35	);
36
37
38my $dotfile = '.resolv.conf';
39my @dotpath = grep {$_} $ENV{HOME}, '.';
40my @dotfile = grep { -f $_ && -o _ } map {"$_/$dotfile"} @dotpath;
41
42
43my %option = (				## map MVS config option names
44	NSPORTADDR	   => 'port',
45	RESOLVERTIMEOUT	   => 'retrans',
46	RESOLVERUDPRETRIES => 'retry',
47	SORTLIST	   => 'sortlist',
48	);
49
50
51sub _init {
52	my $defaults = shift->_defaults;
53	my %stop;
54	local $ENV{PATH} = join ':', grep {$_} qw(/bin /usr/bin), $ENV{PATH};
55
56	foreach my $dataset ( Net::DNS::Resolver::Base::_untaint( grep {$_} @dataset ) ) {
57		eval {
58			local $_;
59			my @nameserver;
60			my @searchlist;
61
62			my $handle = IO::File->new( qq[cat "$dataset" 2>/dev/null], '-|' )
63					or die "$dataset: $!";	# "cat" able to read MVS datasets
64
65			while (<$handle>) {
66				s/[;#].*$//;			# strip comment
67				s/^\s+//;			# strip leading white space
68				next unless $_;			# skip empty line
69
70				next if m/^\w+:/ && !m/^$sysname:/oi;
71				s/^\w+:\s*//;			# discard qualifier
72
73
74				m/^(NSINTERADDR|nameserver)/i && do {
75					my ( $keyword, @ip ) = grep {defined} split;
76					push @nameserver, @ip;
77					next;
78				};
79
80
81				m/^(DOMAINORIGIN|domain)/i && do {
82					my ( $keyword, @domain ) = grep {defined} split;
83					$defaults->domain(@domain) unless $stop{domain}++;
84					next;
85				};
86
87
88				m/^search/i && do {
89					my ( $keyword, @domain ) = grep {defined} split;
90					push @searchlist, @domain;
91					next;
92				};
93
94
95				m/^option/i && do {
96					my ( $keyword, @option ) = grep {defined} split;
97					foreach (@option) {
98						my ( $attribute, @value ) = split m/:/;
99						$defaults->_option( $attribute, @value )
100								unless $stop{$attribute}++;
101					}
102					next;
103				};
104
105
106				m/^RESOLVEVIA/i && do {
107					my ( $keyword, $value ) = grep {defined} split;
108					$defaults->_option( 'usevc', $value eq 'TCP' )
109							unless $stop{usevc}++;
110					next;
111				};
112
113
114				m/^\w+\s*/ && do {
115					my ( $keyword, @value ) = grep {defined} split;
116					my $attribute = $option{uc $keyword} || next;
117					$defaults->_option( $attribute, @value )
118							unless $stop{$attribute}++;
119				};
120			}
121
122			close($handle);
123
124			$defaults->nameserver(@nameserver) if @nameserver && !$stop{nameserver}++;
125			$defaults->searchlist(@searchlist) if @searchlist && !$stop{search}++;
126		};
127		warn $@ if $@;
128	}
129
130	%$defaults = Net::DNS::Resolver::Base::_untaint(%$defaults);
131
132	$defaults->_read_config_file($_) foreach @dotfile;
133
134	$defaults->_read_env;
135	return;
136}
137
138
1391;
140__END__
141
142
143=head1 SYNOPSIS
144
145    use Net::DNS::Resolver;
146
147=head1 DESCRIPTION
148
149This class implements the OS specific portions of C<Net::DNS::Resolver>.
150
151No user serviceable parts inside, see L<Net::DNS::Resolver>
152for all your resolving needs.
153
154=head1 COPYRIGHT
155
156Copyright (c)2017 Dick Franks.
157
158All rights reserved.
159
160=head1 LICENSE
161
162Permission to use, copy, modify, and distribute this software and its
163documentation for any purpose and without fee is hereby granted, provided
164that the above copyright notice appear in all copies and that both that
165copyright notice and this permission notice appear in supporting
166documentation, and that the name of the author not be used in advertising
167or publicity pertaining to distribution of the software without specific
168prior written permission.
169
170THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
171IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
172FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
173THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
174LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
175FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
176DEALINGS IN THE SOFTWARE.
177
178=head1 SEE ALSO
179
180L<perl>, L<Net::DNS>, L<Net::DNS::Resolver>
181
182=cut
183
184