﻿Socket/SSL.pod                                                                                      0000644                 00000251751 00000000000 0007115 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       
=head1 NAME

IO::Socket::SSL - SSL sockets with IO::Socket interface

=head1 SYNOPSIS

    use strict;
    use IO::Socket::SSL;

    # simple client
    my $cl = IO::Socket::SSL->new('www.google.com:443');
    print $cl "GET / HTTP/1.0\r\n\r\n";
    print <$cl>;

    # simple server
    my $srv = IO::Socket::SSL->new(
	LocalAddr => '0.0.0.0:1234',
	Listen => 10,
	SSL_cert_file => 'server-cert.pem',
	SSL_key_file => 'server-key.pem',
    );
    $srv->accept;

=head1 DESCRIPTION

IO::Socket::SSL makes using SSL/TLS much easier by wrapping the necessary
functionality into the familiar L<IO::Socket> interface and providing secure
defaults whenever possible.
This way, existing applications can be made SSL-aware without much effort, at
least if you do blocking I/O and don't use select or poll.

But, under the hood, SSL is a complex beast.
So there are lots of methods to make it do what you need if the default
behavior is not adequate.
Because it is easy to inadvertently introduce critical security bugs or just
hard to debug problems, I would recommend studying the following
documentation carefully.

The documentation consists of the following parts:

=over 4

=item * L</"Essential Information About SSL/TLS">

=item * L</"Basic SSL Client">

=item * L</"Basic SSL Server">

=item * L</"Common Usage Errors">

=item * L</"Common Problems with SSL">

=item * L</"Using Non-Blocking Sockets">

=item * L</"Advanced Usage">

=item * L</"Integration Into Own Modules">

=item * L</"Description Of Methods">

=back

Additional documentation can be found in

=over 4

=item * L<IO::Socket::SSL::Intercept> - Doing Man-In-The-Middle with SSL

=item * L<IO::Socket::SSL::Utils> - Useful functions for certificates etc

=back


=head1 Essential Information About SSL/TLS

SSL (Secure Socket Layer) or its successor TLS (Transport Layer Security) are
protocols to facilitate end-to-end security. These protocols are used when
accessing web sites (https), delivering or retrieving email, and in lots of other
use cases.
In the following documentation we will refer to both SSL and TLS as simply 'SSL'.

SSL enables end-to-end security by providing two essential functions:

=over 4

=item Encryption

This part encrypts the data for transit between the communicating parties, so
that nobody in between can read them. It also provides tamper resistance so that
nobody in between can manipulate the data.

=item Identification

This part makes sure that you talk to the right peer.
If the identification is done incorrectly it is easy to mount man-in-the-middle
attacks, e.g. if Alice wants to talk to Bob it would be possible for Mallory to
put itself in the middle, so that Alice talks to Mallory and Mallory to Bob.
All the data would still be encrypted, but not end-to-end between Alice and Bob,
but only between Alice and Mallory and then between Mallory and Bob.
Thus Mallory would be able to read and modify all traffic between Alice and Bob.

=back

Identification is the part which is the hardest to understand and the easiest
to get wrong.

With SSL, the Identification is usually done with B<certificates> inside a B<PKI>
(Public Key Infrastructure).
These Certificates are comparable to an identity card, which contains
information about the owner of the card. The card then is somehow B<signed> by
the B<issuer> of the card, the B<CA> (Certificate Agency).

To verify the identity of the peer the following must be done inside SSL:

=over 4

=item *

Get the certificate from the peer.
If the peer does not present a certificate we cannot verify it.

=item *

Check if we trust the certificate, e.g. make sure it's not a forgery.

We believe that a certificate is not a fake if we either know the certificate
already or if we B<trust> the issuer (the CA) and can verify the issuers
signature on the certificate.
In reality there is often a hierarchy of certificate agencies and we only
directly trust the root of this hierarchy.
In this case the peer not only sends his own certificate, but also all
B<intermediate certificates>.
Verification will be done by building a B<trust path> from the trusted root up
to the peers certificate and checking in each step if the we can verify the
issuer's signature.

This step often causes problems because the client does not know the necessary
trusted root certificates. These are usually stored in a system dependent
CA store, but often the browsers have their own CA store.

=item *

Check if the certificate is still valid.
Each certificate has a lifetime and should not be used after that time because
it might be compromised or the underlying cryptography got broken in the mean
time.

=item *

Check if the subject of the certificate matches the peer.
This is like comparing the picture on the identity card against the person
representing the identity card.

When connecting to a server this is usually done by comparing the hostname used
for connecting against the names represented in the certificate.
A certificate might contain multiple names or wildcards, so that it can be used
for multiple hosts (e.g.  *.example.com and *.example.org).

Although nobody sane would accept an identity card where the picture does not
match the person we see, it is a common implementation error with SSL to omit
this check or get it wrong.

=item *

Check if the certificate was revoked by the issuer.
This might be the case if the certificate was compromised somehow and now
somebody else might use it to claim the wrong identity.
Such revocations happened a lot after the heartbleed attack.

For SSL there are two ways to verify a revocation, CRL and OCSP.
With CRLs (Certificate Revocation List) the CA provides a list of serial numbers
for revoked certificates. The client somehow has to download the list
(which can be huge) and keep it up to date.
With OCSP (Online Certificate Status Protocol) the client can check a single
certificate directly by asking the issuer.

Revocation is the hardest part of the verification and none of today's browsers
get it fully correct. But, they are still better than most other implementations
which don't implement revocation checks or leave the hard parts to the
developer.

=back

When accessing a web site with SSL or delivering mail in a secure way the
identity is usually only checked one way, e.g. the client wants to make sure it
talks to the right server, but the server usually does not care which client it
talks to.
But, sometimes the server wants to identify the client too and will request a
certificate from the client which the server must verify in a similar way.


=head1 Basic SSL Client

A basic SSL client is simple:

    my $client = IO::Socket::SSL->new('www.example.com:443')
	or die "error=$!, ssl_error=$SSL_ERROR";

This will take the OpenSSL default CA store as the store for the trusted CA.
This usually works on UNIX systems.
If there are no certificates in the store it will try use L<Mozilla::CA> which
provides the default CAs of Firefox.

In the default settings, L<IO::Socket::SSL> will use a safer cipher set and SSL
version, do a proper hostname check against the certificate, and use SNI (server
name indication) to send the hostname inside the SSL handshake. This is
necessary to work with servers which have different certificates behind the
same IP address.
It will also check the revocation of the certificate with OCSP, but currently
only if the server provides OCSP stapling (for deeper checks see
C<ocsp_resolver> method).

Lots of options can be used to change ciphers, SSL version, location of CA and
much more. See documentation of methods for details.

With protocols like SMTP it is necessary to upgrade an existing socket to SSL.
This can be done like this:

    my $client = IO::Socket::INET->new('mx.example.com:25') or die $!;
    # .. read greeting from server
    # .. send EHLO and read response
    # .. send STARTTLS command and read response
    # .. if response was successful we can upgrade the socket to SSL now:
    IO::Socket::SSL->start_SSL($client,
	# explicitly set hostname we should use for SNI
	SSL_hostname => 'mx.example.com'
    ) or die $SSL_ERROR;

A more complete example for a simple HTTP client:

    my $client = IO::Socket::SSL->new(
	# where to connect
	PeerHost => "www.example.com",
	PeerPort => "https",

	# certificate verification - VERIFY_PEER is default
	SSL_verify_mode => SSL_VERIFY_PEER,

	# location of CA store
	# need only be given if default store should not be used
	SSL_ca_path => '/etc/ssl/certs', # typical CA path on Linux
	SSL_ca_file => '/etc/ssl/cert.pem', # typical CA file on BSD

	# or just use default path on system:
	IO::Socket::SSL::default_ca(), # either explicitly
	# or implicitly by not giving SSL_ca_*

	# easy hostname verification
	# It will use PeerHost as default name a verification
	# scheme as default, which is safe enough for most purposes.
	SSL_verifycn_name => 'foo.bar',
	SSL_verifycn_scheme => 'http',

	# SNI support - defaults to PeerHost
	SSL_hostname => 'foo.bar',

    ) or die "failed connect or ssl handshake: $!,$SSL_ERROR";

    # send and receive over SSL connection
    print $client "GET / HTTP/1.0\r\n\r\n";
    print <$client>;

And to do revocation checks with OCSP (only available with OpenSSL 1.0.0 or
higher and L<Net::SSLeay> 1.59 or higher):

    # default will try OCSP stapling and check only leaf certificate
    my $client = IO::Socket::SSL->new($dst);

    # better yet: require checking of full chain
    my $client = IO::Socket::SSL->new(
	PeerAddr => $dst,
	SSL_ocsp_mode => SSL_OCSP_FULL_CHAIN,
    );

    # even better: make OCSP errors fatal
    # (this will probably fail with lots of sites because of bad OCSP setups)
    # also use common OCSP response cache
    my $ocsp_cache = IO::Socket::SSL::OCSP_Cache->new;
    my $client = IO::Socket::SSL->new(
	PeerAddr => $dst,
	SSL_ocsp_mode => SSL_OCSP_FULL_CHAIN|SSL_OCSP_FAIL_HARD,
	SSL_ocsp_cache => $ocsp_cache,
    );

    # disable OCSP stapling in case server has problems with it
    my $client = IO::Socket::SSL->new(
	PeerAddr => $dst,
	SSL_ocsp_mode => SSL_OCSP_NO_STAPLE,
    );

    # check any certificates which are not yet checked by OCSP stapling or
    # where we have already cached results. For your own resolving combine
    # $ocsp->requests with $ocsp->add_response(uri,response).
    my $ocsp = $client->ocsp_resolver();
    my $errors = $ocsp->resolve_blocking();
    if ($errors) {
	warn "OCSP verification failed: $errors";
	close($client);
    }

=head1 Basic SSL Server

A basic SSL server looks similar to other L<IO::Socket> servers, only that it
also contains settings for certificate and key:

    # simple server
    my $server = IO::Socket::SSL->new(
	# where to listen
	LocalAddr => '127.0.0.1',
	LocalPort => 8080,
	Listen => 10,

	# which certificate to offer
	# with SNI support there can be different certificates per hostname
	SSL_cert_file => 'cert.pem',
	SSL_key_file => 'key.pem',
    ) or die "failed to listen: $!";

    # accept client
    my $client = $server->accept or die
	"failed to accept or ssl handshake: $!,$SSL_ERROR";

This will automatically use a secure set of ciphers and SSL version and also
supports Forward Secrecy with (Elliptic-Curve) Diffie-Hellmann Key Exchange.

If you are doing a forking or threading server, we recommend that you do the SSL
handshake inside the new process/thread so that the master is free for new
connections.
We recommend this because a client with improper or slow SSL handshake could
make the server block in the handshake which would be bad to do on the
listening socket:

    # inet server
    my $server = IO::Socket::INET->new(
	# where to listen
	LocalAddr => '127.0.0.1',
	LocalPort => 8080,
	Listen => 10,
    );

    # accept client
    my $client = $server->accept or die;

    # SSL upgrade client (in new process/thread)
    IO::Socket::SSL->start_SSL($client,
	SSL_server => 1,
	SSL_cert_file => 'cert.pem',
	SSL_key_file => 'key.pem',
    ) or die "failed to ssl handshake: $SSL_ERROR";

Like with normal sockets, neither forking nor threading servers scale well.
It is recommended to use non-blocking sockets instead, see
L</"Using Non-Blocking Sockets">

=head1 Common Usage Errors

This is a list of typical errors seen with the use of L<IO::Socket::SSL>:

=over 4

=item *

Disabling verification with C<SSL_verify_mode>.

As described in L</"Essential Information About SSL/TLS">, a proper
identification of the peer is essential and failing to verify makes
Man-In-The-Middle attacks possible.

Nevertheless, lots of scripts and even public modules or applications disable
verification, because it is probably the easiest way to make the thing work
and usually nobody notices any security problems anyway.

If the verification does not succeed with the default settings, one can do the
following:

=over 8

=item *

Make sure the needed CAs are in the store, maybe use C<SSL_ca_file> or
C<SSL_ca_path> to specify a different CA store.

=item *

If the validation fails because the certificate is self-signed and that's what
you expect, you can use the C<SSL_fingerprint> option to accept specific
leaf certificates by their certificate or pubkey fingerprint.

=item *

If the validation failed because the hostname does not match and you cannot
access the host with the name given in the certificate, you can use
C<SSL_verifycn_name> to specify the hostname you expect in the certificate.

=back

A common error pattern is also to disable verification if they found no CA
store (different modules look at different "default" places).
Because L<IO::Socket::SSL> is now able to provide a usable CA store on most
platforms (UNIX, Mac OSX and Windows) it is better to use the defaults provided
by L<IO::Socket::SSL>.
If necessary these can be checked with the C<default_ca> method.

=item *

Polling of SSL sockets (e.g. select, poll and other event loops).

If you sysread one byte on a normal socket it will result in a syscall to read
one byte. Thus, if more than one byte is available on the socket it will be kept
in the network stack of your OS and the next select or poll call will return the
socket as readable.
But, with SSL you don't deliver single bytes. Multiple data bytes are packaged
and encrypted together in an SSL frame. Decryption can only be done on the whole
frame, so a sysread for one byte actually reads the complete SSL frame from the
socket, decrypts it and returns the first decrypted byte. Further sysreads will
return more bytes from the same frame until all bytes are returned and the
next SSL frame will be read from the socket.

Thus, in order to decide if you can read more data (e.g. if sysread will block)
you must check if there are still data in the current SSL frame by calling
C<pending> and if there are no data pending you might check the underlying
socket with select or poll.
Another way might be if you try to sysread at least 16kByte all the time.
16kByte is the maximum size of an SSL frame and because sysread returns data
from only a single SSL frame you can guarantee that there are no pending
data.

Additionally, contrary to plain sockets the  data delivered on the socket are
not necessarily application payload.
It might be a TLS handshake, it might just be the beginning of a TLS record or
it might be TLS session tickets which are send after the TLS handshake in TLS
1.3.
In such situations select will return that data are available for read since it
only looks at the plain socket.
A sysread on the IO::Socket::SSL socket will not return any data though since it
is an abstraction which only returns application data.
This causes the sysread to hang in case the socket was blocking or to return
an error with EAGAIN on non-blocking sockets.
Applications using select or similar should therefore set the socket to
non-blocking and also expect that the sysread might temporarily fail with
EAGAIN.

See also L</"Using Non-Blocking Sockets">.

=item *

Expecting exactly the same behavior as plain sockets.

IO::Socket::SSL tries to emulate the usual socket behavior as good as possible,
but full emulation can not be done. Specifically a read on the SSL socket might
also result in a write on the TCP socket or a write on the SSL socket might
result in a read on the TCP socket. Also C<accept> and B<close> on the SSL
socket will result in writing and reading data to the TCP socket too.

Especially the hidden writes might result in a connection reset if the
underlying TCP socket is already closed by the peer. Unless signal PIPE is
explicitly handled by the application this will usually result in the
application crashing. It is thus recommended to explicitly IGNORE signal PIPE so
that the errors get propagated as EPIPE instead of causing a crash of the
application.

=item *

Set 'SSL_version' or 'SSL_cipher_list' to a "better" value.

L<IO::Socket::SSL> tries to set these values to reasonable, secure values which
are compatible with the rest of the world.
But, there are some scripts or modules out there which tried to be smart and
get more secure or compatible settings.
Unfortunately, they did this years ago and never updated these values, so they
are still forced to do only 'TLSv1' (instead of also using TLSv12 or TLSv11).
Or they set 'HIGH' as the cipher list and thought they were secure, but did not
notice that 'HIGH' includes anonymous ciphers, e.g. without identification of
the peer.

So it is recommended to leave the settings at the secure defaults which
L<IO::Socket::SSL> sets and which get updated from time to time to
better fit the real world.

=item *

Make SSL settings inaccessible by the user, together with bad builtin settings.

Some modules use L<IO::Socket::SSL>, but don't make the SSL settings available
to the user. This is often combined with bad builtin settings or defaults (like
switching verification off).

Thus the user needs to hack around these restrictions by using
C<set_args_filter_hack> or similar.

=item *

Use of constants as strings.

Constants like C<SSL_VERIFY_PEER> or C<SSL_WANT_READ> should be used as
constants and not be put inside quotes, because they represent numerical values.

=item *

Forking and handling the socket in parent and child.

A B<fork> of the process will duplicate the internal user space SSL state of the
socket. If both master and child interact with the socket by using their own SSL
state strange error messages will happen. Such interaction includes explicit or
implicit B<close> of the SSL socket. To avoid this the socket should be explicitly
closed with B<SSL_no_shutdown>.

=item *

Forking and executing a new process.

Since the SSL state is stored in user space it will be duplicated by a B<fork> but
it will be lost when doing B<exec>. This means it is not possible to simply
redirect stdin and stdout for the new process to the SSL socket by duplicating
the relevant file handles. Instead explicitly exchanging plain data between
child-process and SSL socket are needed.

=back



=head1 Common Problems with SSL

SSL is a complex protocol with multiple implementations and each of these has
their own quirks. While most of these implementations work together, it often
gets problematic with older versions, minimal versions in load balancers, or plain
wrong setups.

Unfortunately these problems are hard to debug.
Helpful for debugging are a knowledge of SSL internals, wireshark and the use of
the debug settings of L<IO::Socket::SSL> and L<Net::SSLeay>, which can both be
set with C<$IO::Socket::SSL::DEBUG>.
The following debugs levels are defined, but used not in any consistent way:

=over 4

=item *

0 - No debugging (default).

=item *

1 - Print out errors from L<IO::Socket::SSL> and ciphers from L<Net::SSLeay>.

=item *

2 - Print also information about call flow from L<IO::Socket::SSL> and progress
information from L<Net::SSLeay>.

=item *

3 - Print also some data dumps from L<IO::Socket::SSL> and from L<Net::SSLeay>.

=back

Also, C<analyze-ssl.pl> from the ssl-tools repository at
L<https://github.com/noxxi/p5-ssl-tools>  might be a helpful tool when debugging
SSL problems, as do the C<openssl> command line tool and a check with a
different SSL implementation (e.g. a web browser).

The following problems are not uncommon:

=over 4

=item *

Bad server setup: missing intermediate certificates.

It is a regular problem that administrators fail to include all necessary
certificates into their server setup, e.g. everything needed to build the trust
chain from the trusted root.
If they check the setup with the browser everything looks ok, because browsers
work around these problems by caching any intermediate certificates and apply
them to new connections if certificates are missing.

But, fresh browser profiles which have never seen these intermediates cannot
fill in the missing certificates and fail to verify; the same is true with
L<IO::Socket::SSL>.

=item *

Old versions of servers or load balancers which do not understand specific TLS
versions or croak on specific data.

From time to time one encounters an SSL peer, which just closes the connection
inside the SSL handshake. This can usually be worked around by downgrading the
SSL version, e.g. by setting C<SSL_version>. Modern Browsers usually deal with
such servers by automatically downgrading the SSL version and repeat the
connection attempt until they succeed.

Worse servers do not close the underlying TCP connection but instead just
drop the relevant packet. This is harder to detect because it looks like a
stalled connection. But downgrading the SSL version often works here too.

A cause of such problems are often load balancers or security devices, which
have hardware acceleration and only a minimal (and less robust) SSL stack. They
can often be detected because they support much fewer ciphers than other
implementations.

=item *

Bad or old OpenSSL versions.

L<IO::Socket::SSL> uses OpenSSL with the help of the L<Net::SSLeay> library. It
is recommend to have a recent version of this library, because it has more
features and usually fewer known bugs.

=item *

Validation of client certificates fail.

Make sure that the purpose of the certificate allows use as ssl client (check
with C<< openssl x509 -purpose >>, that the necessary root certificate is in the
path specified by C<SSL_ca*> (or the default path) and that any intermediate
certificates needed to build the trust chain are sent by the client.

=item * 

Validation of self-signed certificate fails even if it is given with
C<SSL_ca*> argument.

The C<SSL_ca*> arguments do not give a general trust store for arbitrary
certificates but only specify a store for CA certificates which then can be used
to verify other certificates.  This especially means that certificates which are
not a CA get simply ignored, notably self-signed certificates which do not also
have the CA-flag set.

This behavior of OpenSSL differs from the more general trust-store concept which
can be found in browsers and where it is possible to simply added arbitrary
certificates (CA or not) as trusted.


=back



=head1 Using Non-Blocking Sockets

If you have a non-blocking socket, the expected behavior on read, write, accept
or connect is to set C<$!> to EWOULDBLOCK if the operation cannot be completed
immediately. Note that EWOULDBLOCK is the same as EAGAIN on UNIX systems, but
is different on Windows.

With SSL, handshakes might occur at any time, even within an established
connection. In these cases it is necessary to finish the handshake before
you can read or write data. This might result in situations where you want to
read but must first finish the write of a handshake or where you want to write
but must first finish a read.
In these cases C<$!> is set to EAGAIN like expected, and additionally
C<$SSL_ERROR> is set to either SSL_WANT_READ or SSL_WANT_WRITE.
Thus if you get EWOULDBLOCK on a SSL socket you must check C<$SSL_ERROR> for
SSL_WANT_* and adapt your event mask accordingly.

Using readline on non-blocking sockets does not make much sense and I would
advise against using it.
And, while the behavior is not documented for other L<IO::Socket> classes, it
will try to emulate the behavior seen there, e.g. to return the received data
instead of blocking, even if the line is not complete. If an unrecoverable error
occurs it will return nothing, even if it already received some data.

Also, I would advise against using C<accept> with a non-blocking SSL object
because it might block and this is not what most would expect. The reason for
this is that C<accept> on a non-blocking TCP socket (e.g. L<IO::Socket::IP>,
L<IO::Socket::INET>..) results in a new TCP socket which does not inherit the
non-blocking behavior of the master socket. And thus, the initial SSL handshake
on the new socket inside C<IO::Socket::SSL::accept> will be done in a blocking
way. To work around this you are safer by doing a TCP accept and later upgrade the
TCP socket in a non-blocking way with C<start_SSL> and C<accept_SSL>.

    my $cl = IO::Socket::SSL->new($dst);
    $cl->blocking(0);
    my $sel = IO::Select->new($cl);
    while (1) {
	# with SSL a call for reading n bytes does not result in reading of n
	# bytes from the socket, but instead it must read at least one full SSL
	# frame. If the socket has no new bytes, but there are unprocessed data
	# from the SSL frame can_read will block!

	# wait for data on socket
	$sel->can_read();

	# new data on socket or eof
	READ:
	# this does not read only 1 byte from socket, but reads the complete SSL
	# frame and then just returns one byte. On subsequent calls it than
	# returns more byte of the same SSL frame until it needs to read the
	# next frame.
	my $n = sysread( $cl,my $buf,1);
	if ( ! defined $n ) {
	    die $! if not $!{EWOULDBLOCK};
	    next if $SSL_ERROR == SSL_WANT_READ;
	    if ( $SSL_ERROR == SSL_WANT_WRITE ) {
		# need to write data on renegotiation
		$sel->can_write;
		next;
	    }
	    die "something went wrong: $SSL_ERROR";
	} elsif ( ! $n ) {
	    last; # eof
	} else {
	    # read next bytes
	    # we might have still data within the current SSL frame
	    # thus first process these data instead of waiting on the underlying
	    # socket object
	    goto READ if $cl->pending;    # goto sysread
	    next;                         # goto $sel->can_read
	}
    }


Additionally there are differences to plain sockets when using select, poll,
kqueue or similar technologies to get notified if data are available.
Relying only on these calls is not sufficient in all cases since unread data
might be internally buffered in the SSL stack. To detect such buffering
B<pending()> need to be used. Alternatively the buffering can be avoided by using
B<sysread> with the maximum size of an SSL frame. See L</"Common Usage Errors">
for details.

=head1 Advanced Usage

=head2 SNI Support

Newer extensions to SSL can distinguish between multiple hostnames on the same
IP address using Server Name Indication (SNI).

Support for SNI on the client side was added somewhere in the OpenSSL 0.9.8
series, but with 1.0 a bug was fixed when the server could not decide about
its hostname. Therefore client side SNI is only supported with OpenSSL 1.0 or
higher in L<IO::Socket::SSL>.
With a supported version, SNI is used automatically on the client side, if it
can determine the hostname from C<PeerAddr> or C<PeerHost> (which are synonyms
in the underlying IO::Socket:: classes and thus should never be set both or at
least not to different values).
On unsupported OpenSSL versions it will silently not use SNI.
The hostname can also be given explicitly given with C<SSL_hostname>, but in
this case it will throw in error, if SNI is not supported.
To check for support you might call C<< IO::Socket::SSL->can_client_sni() >>.

On the server side, earlier versions of OpenSSL are supported, but only together
with L<Net::SSLeay> version >= 1.50.
To check for support you might call C<< IO::Socket::SSL->can_server_sni() >>.
If server side SNI is supported, you might specify different certificates per
host with C<SSL_cert*> and C<SSL_key*>, and check the requested name using
C<get_servername>.

=head2 Talk Plain and SSL With The Same Socket

It is often required to first exchange some plain data and then upgrade the
socket to SSL after some kind of STARTTLS command. Protocols like FTPS even
need a way to downgrade the socket again back to plain.

The common way to do this would be to create a normal socket and use C<start_SSL>
to upgrade and stop_SSL to downgrade:

    my $sock = IO::Socket::INET->new(...) or die $!;
    ... exchange plain data on $sock until starttls command ...
    IO::Socket::SSL->start_SSL($sock,%sslargs) or die $SSL_ERROR;
    ... now $sock is an IO::Socket::SSL object ...
    ... exchange data with SSL on $sock until stoptls command ...
    $sock->stop_SSL or die $SSL_ERROR;
    ... now $sock is again an IO::Socket::INET object ...

But, lots of modules just derive directly from L<IO::Socket::INET>.
While this base class can be replaced with L<IO::Socket::SSL>, these modules cannot
easily support different base classes for SSL and plain data and switch between
these classes on a starttls command.

To help in this case, L<IO::Socket::SSL> can be reduced to a plain socket on
startup, and connect_SSL/accept_SSL/start_SSL can be used to enable SSL and
C<stop_SSL> to talk plain again:

    my $sock = IO::Socket::SSL->new(
	PeerAddr => ...
	SSL_startHandshake => 0,
	%sslargs
    ) or die $!;
    ... exchange plain data on $sock until starttls command ...
    $sock->connect_SSL or die $SSL_ERROR;
    ... now $sock is an IO::Socket::SSL object ...
    ... exchange data with SSL on $sock until stoptls command ...
    $sock->stop_SSL or die $SSL_ERROR;
    ... $sock is still an IO::Socket::SSL object ...
    ... but data exchanged again in plain ...


=head1 Integration Into Own Modules

L<IO::Socket::SSL> behaves similarly to other L<IO::Socket> modules and thus could
be integrated in the same way, but you have to take special care when using
non-blocking I/O (like for handling timeouts) or using select or poll.
Please study the documentation on how to deal with these differences.

Also, it is recommended to not set or touch most of the C<SSL_*> options, so
that they keep their secure defaults. It is also recommended to let the user
override these SSL specific settings without the need of global settings or hacks
like C<set_args_filter_hack>.

The notable exception is C<SSL_verifycn_scheme>.
This should be set to the hostname verification scheme required by the module or
protocol.




=head1 Description Of Methods

L<IO::Socket::SSL> inherits from another L<IO::Socket> module.
The choice of the super class depends on the installed modules:

=over 4

=item *

If L<IO::Socket::IP> with at least version 0.20 is installed it will use this
module as super class, transparently providing IPv6 and IPv4 support.

=item *

If L<IO::Socket::INET6> is installed it will use this module as super class,
transparently providing IPv6 and IPv4 support.

=item *

Otherwise it will fall back to L<IO::Socket::INET>, which is a perl core module.
With L<IO::Socket::INET> you only get IPv4 support.

=back

Please be aware that with the IPv6 capable super classes, it will look first
for the IPv6 address of a given hostname. If the resolver provides an IPv6
address, but the host cannot be reached by IPv6, there will be no automatic
fallback to IPv4.
To avoid these problems you can enforce IPv4 for a specific socket by
using the C<Domain> or C<Family> option with the value AF_INET as described in
L<IO::Socket::IP>. Alternatively you can enforce IPv4 globally by loading
L<IO::Socket::SSL> with the option 'inet4', in which case it will use the IPv4
only class L<IO::Socket::INET> as the super class.

L<IO::Socket::SSL> will provide all of the methods of its super class, but
sometimes it will override them to match the behavior expected from SSL or to
provide additional arguments.

The new or changed methods are described below, but please also read the
section about SSL specific error handling.

=over 4

=item Error Handling

If an SSL specific error occurs, the global variable C<$SSL_ERROR> will be set.
If the error occurred on an existing SSL socket, the method C<errstr> will
give access to the latest socket specific error.
Both C<$SSL_ERROR> and the C<errstr> method give a dualvar similar to C<$!>, e.g.
providing an error number in numeric context or an error description in string
context.


=item B<new(...)>

Creates a new L<IO::Socket::SSL> object.  You may use all the friendly options
that came bundled with the super class (e.g. L<IO::Socket::IP>,
L<IO::Socket::INET>, ...) plus (optionally) the ones described below.
If you don't specify any SSL related options it will do its best in using
secure defaults, e.g. choosing good ciphers, enabling proper verification, etc.

=over 2

=item SSL_server

Set this option to a true value if the socket should be used as a server.
If this is not explicitly set it is assumed if the C<Listen> parameter is given
when creating the socket.

=item SSL_hostname

This can be given to specify the hostname used for SNI, which is needed if you
have multiple SSL hostnames on the same IP address. If not given it will try to
determine the hostname from C<PeerAddr>, which will fail if only an IP was given or if
this argument is used within C<start_SSL>.

If you want to disable SNI, set this argument to ''.

Currently only supported for the client side and will be ignored for the server
side.

See section "SNI Support" for details of SNI the support.

=item SSL_startHandshake

If this option is set to false (defaults to true) it will not start the SSL
handshake yet. This has to be done later with C<accept_SSL> or C<connect_SSL>.
Before the handshake is started read/write/etc. can be used to exchange plain
data.

=item SSL_keepSocketOnError

If this option is set to true (defaults to false) it will not close the
underlying TCP socket on errors. In most cases there is no real use for this
behavior since both sides of the TCP connection will probably have a
different idea of the current state of the connection.

=item SSL_ca | SSL_ca_file | SSL_ca_path

Usually you want to verify that the peer certificate has been signed by a
trusted certificate authority. In this case you should use this option to
specify the file (C<SSL_ca_file>) or directory (C<SSL_ca_path>) containing the
certificateZ<>(s) of the trusted certificate authorities.

C<SSL_ca_path> can also be an array or a string containing multiple path, where
the path are separated by the platform specific separator. This separator is
C<;> on DOS, Windows, Netware, C<,> on VMS and C<:> for all the other systems.
If multiple path are given at least one of these must be accessible.

You can also give a list of X509* certificate handles (like you get from
L<Net::SSLeay> or L<IO::Socket::SSL::Utils::PEM_xxx2cert>) with C<SSL_ca>. These
will be added to the CA store before path and file and thus take precedence.
If neither SSL_ca, nor SSL_ca_file or SSL_ca_path are set it will use
C<default_ca()> to determine the user-set or system defaults.
If you really don't want to set a CA set SSL_ca_file or SSL_ca_path to
C<\undef> or SSL_ca to an empty list. (unfortunately C<''> is used by some
modules using L<IO::Socket::SSL> when CA is not explicitly given).

=item SSL_client_ca | SSL_client_ca_file

If verify_mode is VERIFY_PEER on the server side these options can be used to
set the list of acceptable CAs for the client. This way the client can select
they required certificate from a list of certificates.
The value for these options is similar to C<SSL_ca> and C<SSL_ca_file>.

=item SSL_fingerprint

Sometimes you have a self-signed certificate or a certificate issued by an
unknown CA and you really want to accept it, but don't want to disable
verification at all. In this case you can specify the fingerprint of the
certificate as C<'algo$hex_fingerprint'>. C<algo> is a fingerprint algorithm
supported by OpenSSL, e.g. 'sha1','sha256'... and C<hex_fingerprint> is the
hexadecimal representation of the binary fingerprint. Any colons inside the
hex string will be ignored.

If you want to use the fingerprint of the pubkey inside the certificate instead
of the certificate use the syntax C<'algo$pub$hex_fingerprint'> instead.
To get the fingerprint of an established connection you can use
C<get_fingerprint>.

It is also possible to skip C<algo$>, i.e. only specify the fingerprint. In
this case the likely algorithms will be automatically detected based on the
length of the digest string.

You can specify a list of fingerprints in case you have several acceptable
certificates.
If a fingerprint matches the topmost (i.e. leaf) certificate no additional
validations can make the verification fail.

=item SSL_cert_file | SSL_cert | SSL_key_file | SSL_key

If you create a server you usually need to specify a server certificate which
should be verified by the client. Same is true for client certificates, which
should be verified by the server.
The certificate can be given as a file with SSL_cert_file or as an internal
representation of an X509* object (like you get from L<Net::SSLeay> or
L<IO::Socket::SSL::Utils::PEM_xxx2cert>) with SSL_cert.
If given as a file it will automatically detect the format.
Supported file formats are PEM, DER and PKCS#12, where PEM and PKCS#12 can
contain the certificate and the chain to use, while DER can only contain a single
certificate.

If given as a list of X509* please note, that the all the chain certificates
(e.g. all except the first) will be "consumed" by openssl and will be freed
if the SSL context gets destroyed - so you should never free them yourself. But
the servers certificate (e.g. the first) will not be consumed by openssl and
thus must be freed by the application.

For each certificate a key is need, which can either be given as a file with
SSL_key_file or as an internal representation of an EVP_PKEY* object with
SSL_key (like you get from L<Net::SSLeay> or
L<IO::Socket::SSL::Utils::PEM_xxx2key>).
If a key was already given within the PKCS#12 file specified by SSL_cert_file
it will ignore any SSL_key or SSL_key_file.
If no SSL_key or SSL_key_file was given it will try to use the PEM file given
with SSL_cert_file again, maybe it contains the key too.

If your SSL server should be able to use different certificates on the same IP
address, depending on the name given by SNI, you can use a hash reference
instead of a file with C<<hostname => cert_file>>.

If your SSL server should be able to use both RSA and ECDSA certificates for the
same domain/IP a similar hash reference like with SNI is given. The
domain names used to specify the additional certificates should be
C<hostname%whatever>, i.e.  C<hostname%ecc> or similar. This needs at least
OpenSSL 1.0.2. To let the server pick the certificate based on the clients
cipher preference C<SSL_honor_cipher_order> should be set to false.

In case certs and keys are needed but not given it might fall back to builtin
defaults, see "Defaults for Cert, Key and CA".

Examples:

 SSL_cert_file => 'mycert.pem',
 SSL_key_file => 'mykey.pem',

 SSL_cert_file => {
    "foo.example.org" => 'foo-cert.pem',
    "foo.example.org%ecc" => 'foo-ecc-cert.pem',
    "bar.example.org" => 'bar-cert.pem',
    # used when nothing matches or client does not support SNI
    '' => 'default-cert.pem',
    '%ecc' => 'default-ecc-cert.pem',
 },
 SSL_key_file => {
    "foo.example.org" => 'foo-key.pem',
    "foo.example.org%ecc" => 'foo-ecc-key.pem',
    "bar.example.org" => 'bar-key.pem',
    # used when nothing matches or client does not support SNI
    '' => 'default-key.pem',
    '%ecc' => 'default-ecc-key.pem',
 }

=item SSL_passwd_cb

If your private key is encrypted, you might not want the default password prompt
from Net::SSLeay.  This option takes a reference to a subroutine that should
return the password required to decrypt your private key.

=item SSL_use_cert

If this is true, it forces IO::Socket::SSL to use a certificate and key, even if
you are setting up an SSL client.  If this is set to 0 (the default), then you
will only need a certificate and key if you are setting up a server.

SSL_use_cert will implicitly be set if SSL_server is set.
For convenience it is also set if it was not given but a cert was given for use
(SSL_cert_file or similar).


=item SSL_version

Sets the version of the SSL protocol used to transmit data.
'SSLv23' uses a handshake compatible with SSL2.0, SSL3.0 and TLS1.x, while
'SSLv2', 'SSLv3', 'TLSv1', 'TLSv1_1', 'TLSv1_2', or 'TLSv1_3' restrict
handshake and protocol to the specified version.
All values are case-insensitive.  Instead of 'TLSv1_1', 'TLSv1_2', and
'TLSv1_3' one can also use 'TLSv11', 'TLSv12', and 'TLSv13'.  Support for
'TLSv1_1', 'TLSv1_2', and 'TLSv1_3' requires recent versions of Net::SSLeay
and openssl.

Independent from the handshake format you can limit to set of accepted SSL
versions by adding !version separated by ':'.

The default SSL_version is 'SSLv23:!SSLv3:!SSLv2' which means, that the
handshake format is compatible to SSL2.0 and higher, but that the successful
handshake is limited to TLS1.0 and higher, that is no SSL2.0 or SSL3.0 because
both of these versions have serious security issues and should not be used
anymore.
You can also use !TLSv1_1 and !TLSv1_2 to disable TLS versions 1.1 and 1.2 while
still allowing TLS version 1.0.

Setting the version instead to 'TLSv1' might break interaction with older
clients, which need and SSL2.0 compatible handshake. On the other
side some clients just close the connection when they receive a TLS version 1.1
request. In this case setting the version to
'SSLv23:!SSLv2:!SSLv3:!TLSv1_1:!TLSv1_2' might help.

=item SSL_cipher_list

If this option is set the cipher list for the connection will be set to the
given value, e.g. something like 'ALL:!LOW:!EXP:!aNULL'. This will only affect
ciphers for TLS 1.2 and lower. See the OpenSSL documentation
(L<https://www.openssl.org/docs/manmaster/man1/openssl-ciphers.html#CIPHER-STRINGS>)
for more details.

Unless you fail to contact your peer because of no shared ciphers it is
recommended to leave this option at the default setting, which uses the system
default but disables some insecure ciphers which might still be enabled on older
systems.

In case different cipher lists are needed for different SNI hosts a hash can be
given with the host as key and the cipher suite as value, similar to
B<SSL_cert*>.

=item SSL_ciphersuites

If this option is set the TLS 1.3 ciphersuites for the connection will be
set to the given value. This is similar to SSL_cipher_list, but only for TLS 1.3
ciphers. See argument C<-ciphersuits> in the OpenSSL documentation
(L<https://www.openssl.org/docs/manmaster/man1/openssl-ciphers.html>) for
details.

Unless you fail to contact your peer because of no shared ciphers it is
recommended to leave this option at the default setting, which uses the system
default.

In case different cipher lists are needed for different SNI hosts a hash can be
given with the host as key and the cipher suite as value, similar to
B<SSL_cert*>.

=item SSL_honor_cipher_order

If this option is true the cipher order the server specified is used instead
of the order proposed by the client. This option defaults to true to make use of
our secure cipher list setting.

=item SSL_dh_file

To create a server which provides forward secrecy you need to either give the DH
parameters or (better, because faster) the ECDH curve. This setting cares
about DH parameters.

To support non-elliptic Diffie-Hellman key exchange a suitable file needs to
be given here or the SSL_dh should be used with an appropriate value.
See dhparam command in openssl for more information.

If neither C<SSL_dh_file> nor C<SSL_dh> are set a builtin DH parameter with a
length of 2048 bit is used to offer DH key exchange by default. If you don't
want this (e.g. disable DH key exchange) explicitly set this or the C<SSL_dh>
parameter to undef.

=item SSL_dh

Like SSL_dh_file, but instead of giving a file you use a preloaded or generated
DH*.

=item SSL_ecdh_curve

To create a server which provides forward secrecy you need to either give the DH
parameters or (better, because faster) the ECDH curve. This setting cares
about the ECDH curve(s).

To support Elliptic Curve Diffie-Hellmann key exchange the OID or NID of at
least one suitable curve needs to be provided here.

With OpenSSL 1.1.0+ this parameter defaults to C<auto>, which means that it
lets OpenSSL pick the best settings. If support for CTX_set_ecdh_auto is
implemented in Net::SSLeay (needs at least version 1.86) it will use this to
implement the same default.  Otherwise it will default to C<prime256v1>
(builtin of OpenSSL) in order to offer ECDH key exchange by default.

If setting groups or curves is supported by Net::SSLeay (needs at least
version 1.86) then multiple curves can be given here in the order of the
preference, i.e.  C<P-521:P-384:P-256>. When used at the client side this
will include the supported curves as extension in the TLS handshake.

If you don't want to have ECDH key exchange this could be set to undef or
set C<SSL_ciphers> to exclude all of these ciphers.

You can check if ECDH support is available by calling
C<< IO::Socket::SSL->can_ecdh >>.

=item SSL_verify_mode

This option sets the verification mode for the peer certificate.
You may combine SSL_VERIFY_PEER (verify_peer), SSL_VERIFY_FAIL_IF_NO_PEER_CERT
(fail verification if no peer certificate exists; ignored for clients),
SSL_VERIFY_CLIENT_ONCE (verify client once; ignored for clients).
See OpenSSL man page for SSL_CTX_set_verify for more information.

The default is SSL_VERIFY_NONE for server  (e.g. no check for client
certificate) and SSL_VERIFY_PEER for client (check server certificate).

=item SSL_verify_callback

If you want to verify certificates yourself, you can pass a sub reference along
with this parameter to do so.  When the callback is called, it will be passed:

=over 4

=item 1.
a true/false value that indicates what OpenSSL thinks of the certificate,

=item 2.
a C-style memory address of the certificate store,

=item 3.
a string containing the certificate's issuer attributes and owner attributes,
and

=item 4.
a string containing any errors encountered (0 if no errors).

=item 5.
a C-style memory address of the peer's own certificate (convertible to
PEM form with Net::SSLeay::PEM_get_string_X509()).

=item 6.
The depth of the certificate in the chain. Depth 0 is the leaf certificate.

=back

The function should return 1 or 0, depending on whether it thinks the
certificate is valid or invalid.  The default is to let OpenSSL do all of the
busy work.

The callback will be called for each element in the certificate chain.

See the OpenSSL documentation for SSL_CTX_set_verify for more information.

=item SSL_verifycn_scheme

The scheme is used to correctly verify the identity inside the certificate
by using the hostname of the peer.
See the information about the verification schemes in B<verify_hostname>.

If you don't specify a scheme it will use 'default', but only complain loudly if
the name verification fails instead of letting the whole certificate
verification fail. THIS WILL CHANGE, e.g. it will let the certificate
verification fail in the future if the hostname does not match the certificate
!!!!  To override the name used in verification use B<SSL_verifycn_name>.

The scheme 'default' is a superset of the usual schemes, which will accept the
hostname in common name and subjectAltName and allow wildcards everywhere.
While using this scheme is way more secure than no name verification at all you
better should use the scheme specific to your application protocol, e.g. 'http',
'ftp'...

If you are really sure, that you don't want to verify the identity using the
hostname  you can use 'none' as a scheme. In this case you'd better have
alternative forms of verification, like a certificate fingerprint or do a manual
verification later by calling B<verify_hostname> yourself.

=item SSL_verifycn_publicsuffix

This option is used to specify the behavior when checking wildcards certificates
for public suffixes, e.g. no wildcard certificates for *.com or *.co.uk should
be accepted, while *.example.com or *.example.co.uk is ok.

If not specified it will simply use the builtin default of
L<IO::Socket::SSL::PublicSuffix>, you can create another object with
from_string or from_file of this module.

To disable verification of public suffix set this option to C<''>.

=item SSL_verifycn_name

Set the name which is used in verification of hostname. If SSL_verifycn_scheme
is set and no SSL_verifycn_name is given it will try to use SSL_hostname or
PeerHost and PeerAddr settings and fail if no name can be determined.
If SSL_verifycn_scheme is not set it will use a default scheme and warn if it
cannot determine a hostname, but it will not fail.

Using PeerHost or PeerAddr works only if you create the connection directly
with C<< IO::Socket::SSL->new >>, if an IO::Socket::INET object is upgraded
with B<start_SSL> the name has to be given in B<SSL_verifycn_name> or
B<SSL_hostname>.

=item SSL_check_crl

If you want to verify that the peer certificate has not been revoked
by the signing authority, set this value to true. OpenSSL will search
for the CRL in your SSL_ca_path, or use the file specified by
SSL_crl_file.  See the Net::SSLeay documentation for more details.
Note that this functionality appears to be broken with OpenSSL <
v0.9.7b, so its use with lower versions will result in an error.

=item SSL_crl_file

If you want to specify the CRL file to be used, set this value to the
pathname to be used.  This must be used in addition to setting
SSL_check_crl.

=item SSL_ocsp_mode

Defines how certificate revocation is done using OCSP (Online Status Revocation
Protocol). The default is to send a request for OCSP stapling to the server and
if the server sends an OCSP response back the result will be used.

Any other OCSP checking needs to be done manually with C<ocsp_resolver>.

The following flags can be combined with C<|>:

=over 8

=item SSL_OCSP_NO_STAPLE

Don't ask for OCSP stapling.
This is the default if SSL_verify_mode is VERIFY_NONE.

=item SSL_OCSP_TRY_STAPLE

Try OCSP stapling, but don't complain if it gets no stapled response back.
This is the default if SSL_verify_mode is VERIFY_PEER (the default).

=item SSL_OCSP_MUST_STAPLE

Consider it a hard error, if the server does not send a stapled OCSP response
back. Most servers currently send no stapled OCSP response back.

=item SSL_OCSP_FAIL_HARD

Fail hard on response errors, default is to fail soft like the browsers do.
Soft errors mean, that the OCSP response is not usable, e.g. no response,
error response, no valid signature etc.
Certificate revocations inside a verified response are considered hard errors
in any case.

Soft errors inside a stapled response are never considered hard, e.g. it is
expected that in this case an OCSP request will be send to the responsible
OCSP responder.

=item SSL_OCSP_FULL_CHAIN

This will set up the C<ocsp_resolver> so that all certificates from the peer
chain will be checked, otherwise only the leaf certificate will be checked
against revocation.

=back

=item SSL_ocsp_staple_callback

If this callback is defined, it will be called with the SSL object and the OCSP
response handle obtained from the peer, e.g. C<<$cb->($ssl,$resp)>>.
If the peer did not provide a stapled OCSP response the function will be called
with C<$resp=undef>.
Because the OCSP response handle is no longer valid after leaving this function
it should not by copied or freed. If access to the response is necessary after
leaving this function it can be serialized with
C<Net::SSLeay::i2d_OCSP_RESPONSE>.

If no such callback is provided, it will use the default one, which verifies the
response and uses it to check if the certificate(s) of the connection got
revoked.

=item SSL_ocsp_cache

With this option a cache can be given for caching OCSP responses, which could
be shared between different SSL contexts. If not given a cache specific to the
SSL context only will be used.

You can either create a new cache with
C<< IO::Socket::SSL::OCSP_Cache->new([size]) >> or implement your own cache,
which needs to have methods C<put($key,\%entry)> and C<get($key)> (returning
C<\%entry>) where entry is the hash representation of the OCSP response with
fields like C<nextUpdate>. The default implementation of the cache will consider
responses valid as long as C<nextUpdate> is less then the current time.

=item SSL_reuse_ctx

If you have already set the above options for a previous instance of
IO::Socket::SSL, then you can reuse the SSL context of that instance by passing
it as the value for the SSL_reuse_ctx parameter.  You may also create a
new instance of the IO::Socket::SSL::SSL_Context class, using any context
options that you desire without specifying connection options, and pass that
here instead.

If you use this option, all other context-related options that you pass
in the same call to new() will be ignored unless the context supplied was
invalid.  Note that, contrary to versions of IO::Socket::SSL below v0.90, a
global SSL context will not be implicitly used unless you use the
set_default_context() function.

=item SSL_create_ctx_callback

With this callback you can make individual settings to the context after it
got created and the default setup was done.
The callback will be called with the CTX object from Net::SSLeay as the single
argument.

Example for limiting the server session cache size:

  SSL_create_ctx_callback => sub {
      my $ctx = shift;
      Net::SSLeay::CTX_sess_set_cache_size($ctx,128);
  }

=item SSL_session_cache_size

If you make repeated connections to the same host/port and the SSL renegotiation
time is an issue, you can turn on client-side session caching with this option
by specifying a positive cache size.  For successive connections, pass the
SSL_reuse_ctx option to the new() calls (or use set_default_context()) to make
use of the cached sessions.  The session cache size refers to the number of
unique host/port pairs that can be stored at one time; the oldest sessions in
the cache will be removed if new ones are added.

This option does not effect the session cache a server has for it's clients,
e.g. it does not affect SSL objects with SSL_server set.

Note that session caching with TLS 1.3 needs at least Net::SSLeay 1.86.

=item SSL_session_cache

Specifies session cache object which should be used instead of creating a new.
Overrules SSL_session_cache_size.
This option is useful if you want to reuse the cache, but not the rest of
the context.

A session cache object can be created using
C<< IO::Socket::SSL::Session_Cache->new( cachesize ) >>.

Use set_default_session_cache() to set a global cache object.

=item SSL_session_key

Specifies a key to use for lookups and inserts into client-side session cache.
Per default ip:port of destination will be used, but sometimes you want to
share the same session over multiple ports on the same server (like with FTPS).

=item SSL_session_id_context

This gives an id for the servers session cache. It's necessary if you want
clients to connect with a client certificate. If not given but SSL_verify_mode
specifies the need for client certificate a context unique id will be picked.

=item SSL_error_trap

When using the accept() or connect() methods, it may be the case that the
actual socket connection works but the SSL negotiation fails, as in the case of
an HTTP client connecting to an HTTPS server.  Passing a subroutine ref attached
to this parameter allows you to gain control of the orphaned socket instead of
having it be closed forcibly.
The subroutine, if called, will be passed two parameters:
a reference to the socket on which the SSL negotiation failed and the full
text of the error message.

=item SSL_npn_protocols

If used on the server side it specifies list of protocols advertised by SSL
server as an array ref, e.g. ['spdy/2','http1.1'].
On the client side it specifies the protocols offered by the client for NPN
as an array ref.
See also method C<next_proto_negotiated>.

Next Protocol Negotiation (NPN) is available with Net::SSLeay 1.46+ and
openssl-1.0.1+. NPN is unavailable in TLSv1.3 protocol.
To check support you might call C<< IO::Socket::SSL->can_npn() >>.
If you use this option with an unsupported Net::SSLeay/OpenSSL it will
throw an error.

=item SSL_alpn_protocols

If used on the server side it specifies list of protocols supported by the SSL
server as an array ref, e.g. ['http/2.0', 'spdy/3.1','http/1.1'].
On the client side it specifies the protocols advertised by the client for ALPN
as an array ref.
See also method C<alpn_selected>.

Application-Layer Protocol Negotiation (ALPN) is available with Net::SSLeay
1.56+ and openssl-1.0.2+. More details about the extension are in RFC7301. To
check support you might call C<< IO::Socket::SSL->can_alpn() >>. If you use
this option with an unsupported Net::SSLeay/OpenSSL it will throw an error.

Note that some client implementations may encounter problems if both NPN and
ALPN are specified. Since ALPN is intended as a replacement for NPN, try
providing ALPN protocols then fall back to NPN if that fails.

=item SSL_ticket_keycb => [$sub,$data] | $sub

This is a callback used for stateless session reuse (Session Tickets, RFC 5077).

This callback will be called as C<< $sub->($data,[$key_name]) >> where C<$data>
is the argument given to SSL_ticket_keycb (or undef) and C<$key_name> depends
on the mode:

=over 8

=item encrypt ticket

If a ticket needs to be encrypted the callback will be called without
C<$key_name>. In this case it should return C<($current_key,$current_key_name>)
where C<$current_key> is the current key (32 byte random data) and
C<$current_key_name> the name associated with this key (exactly 16 byte). This
C<$current_key_name> will be incorporated into the ticket.

=item decrypt ticket

If a ticket needs to be decrypted the callback will be called with C<$key_name>
as found in the ticket. It should return C<($key,$current_key_name>) where
C<$key> is the key associated with the given C<$key_name> and
C<$current_key_name> the name associated with the currently active key.
If C<$current_key_name> is different from the given C<$key_name> the callback
will be called again to re-encrypt the ticket with the currently active key.

If no key can be found which matches the given C<$key_name> then this function
should return nothing (empty list).

This mechanism should be used to limit the life time for each key encrypting the
ticket. Compromise of a ticket encryption key might lead to decryption of SSL
sessions which used session tickets protected by this key.

=back

Example:

    Net::SSLeay::RAND_bytes(my $oldkey,32);
    Net::SSLeay::RAND_bytes(my $newkey,32);
    my $oldkey_name = pack("a16",'oldsecret');
    my $newkey_name = pack("a16",'newsecret');

    my @keys = (
       [ $newkey_name, $newkey ], # current active key
       [ $oldkey_name, $oldkey ], # already expired
    );

    my $keycb = [ sub {
       my ($mykeys,$name) = @_;

       # return (current_key, current_key_name) if no name given
       return ($mykeys->[0][1],$mykeys->[0][0]) if ! $name;

       # return (matching_key, current_key_name) if we find a key matching
       # the given name
       for(my $i = 0; $i<@$mykeys; $i++) {
	   next if $name ne $mykeys->[$i][0];
	   return ($mykeys->[$i][1],$mykeys->[0][0]);
       }

       # no matching key found
       return;
    },\@keys ];

    my $srv = IO::Socket::SSL->new(..., SSL_ticket_keycb => $keycb);

=item SSL_mode_release_buffers 1|0

This enables or disables the SSL_MODE_RELEASE_BUFFERS option on the SSL object.
With this option the read buffer will be released after each SSL_read but will
need to be reallocated for each new SSL_read. If memory usage is a concern this
might save lots of memory in the mean time though, about 34k per idle SSL
connection according to the documentation in SSL_CTX_set_mode(3ssl).

=back

=item B<accept>

This behaves similar to the accept function of the underlying socket class, but
additionally does the initial SSL handshake. But because the underlying socket
class does return a blocking file handle even when accept is called on a
non-blocking socket, the SSL handshake on the new file object will be done in a
blocking way. Please see the section about non-blocking I/O for details.
If you don't like this behavior you should do accept on the TCP socket and then
upgrade it with C<start_SSL> later.

=item B<connect(...)>

This behaves similar to the connect function but also does an SSL handshake.
Because you cannot give SSL specific arguments to this function, you should
better either use C<new> to create a connect SSL socket or C<start_SSL> to
upgrade an established TCP socket to SSL.

=item B<close(...)>

Contrary to a close for a simple INET socket a close in SSL also mandates a
proper shutdown of the SSL part. This is done by sending a close notify message
by both peers.

A naive implementation would thus wait until it receives the
close notify message from the peer - which conflicts with the commonly expected
semantic that a close will not block. The default behavior is thus to only send
a close notify but not  wait for the close notify of the peer. If this is
required C<SSL_fast_shutdown> need to be explicitly set to false.

There are also cases where a SSL shutdown should not be done at all. This is
true for example when forking to let a child deal with the socket and closing
the socket in the parent process. A naive explicit C<close> or an implicit close
when destroying the socket in the parent would send a close notify to the peer
which would make the SSL socket in the client process unusable. In this case an
explicit C<close> with C<SSL_no_shutdown> set to true should be done in the
parent process.

For more details and other arguments see C<stop_SSL> which gets called from
C<close> to shutdown the SSL state of the socket.

=item B<sysread( BUF, LEN, [ OFFSET ] )>

This function behaves from the outside the same as B<sysread> in other
L<IO::Socket> objects, e.g. it returns at most LEN bytes of data.
But in reality it reads not only LEN bytes from the underlying socket, but at
a single SSL frame. It then returns up to LEN bytes it decrypted from this SSL
frame. If the frame contained more data than requested it will return only LEN
data, buffer the rest and return it on further read calls.
This means, that it might be possible to read data, even if the underlying
socket is not readable, so using poll or select might not be sufficient.

sysread will only return data from a single SSL frame, e.g. either the pending
data from the already buffered frame or it will read a frame from the underlying
socket and return the decrypted data. It will not return data spanning several
SSL frames in a single call.

Also, calls to sysread might fail, because it must first finish an SSL
handshake.

To understand these behaviors is essential, if you write applications which use
event loops and/or non-blocking sockets. Please read the specific sections in
this documentation.

=item B<syswrite( BUF, [ LEN, [ OFFSET ]] )>

This functions behaves from the outside the same as B<syswrite> in other
L<IO::Socket> objects, e.g. it will write at most LEN bytes to the socket, but
there is no guarantee, that all LEN bytes are written. It will return the number
of bytes written.
Because it basically just calls SSL_write from OpenSSL syswrite will write at
most a single SSL frame. This means, that no more than 16.384 bytes, which is
the maximum size of an SSL frame, will be written at once.

For non-blocking sockets SSL specific behavior applies.
Pease read the specific section in this documentation.

=item B<peek( BUF, LEN, [ OFFSET ])>

This function has exactly the same syntax as B<sysread>, and performs nearly the
same task but will not advance the read position so that successive calls to
peek() with the same arguments will return the same results.  This function
requires OpenSSL 0.9.6a or later to work.

=item B<pending()>

This function gives you the number of bytes available without reading from the
underlying socket object. This function is essential if you work with event
loops, please see the section about polling SSL sockets.

=item B<get_fingerprint([algo,certificate,pubkey])>

This methods returns the fingerprint of the given certificate in the form
C<algo$digest_hex>, where C<algo> is the used algorithm, default 'sha256'.
If no certificate is given the peer certificate of the connection is used.
If C<pubkey> is true it will not return the fingerprint of the certificate but
instead the fingerprint of the pubkey inside the certificate as
C<algo$pub$digest_hex>.

=item B<get_fingerprint_bin([algo,certificate,pubkey])>

This methods returns the binary fingerprint of the given certificate by using
the algorithm C<algo>, default 'sha256'.
If no certificate is given the peer certificate of the connection is used.
If C<pubkey> is true it will not return the fingerprint of the certificate but
instead the fingerprint of the pubkey inside the certificate.

=item B<get_cipher()>

Returns the string form of the cipher that the IO::Socket::SSL object is using.

=item B<get_sslversion()>

Returns the string representation of the SSL version of an established
connection.

=item B<get_sslversion_int()>

Returns the integer representation of the SSL version of an established
connection.

=item B<get_session_reused()>

This returns true if the session got reused and false otherwise. Note that with
a reused session no certificates are send within the handshake and no ciphers
are offered and thus functions which rely on this might not work.

=item B<dump_peer_certificate()>

Returns a parsable string with select fields from the peer SSL certificate.
This method directly returns the result of the dump_peer_certificate() method of
Net::SSLeay.

=item B<peer_certificate($field;[$refresh])>

If a peer certificate exists, this function can retrieve values from it.
If no field is given the internal representation of certificate from Net::SSLeay
is returned.
If refresh is true it will not used a cached version, but check again in case
the certificate of the connection has changed due to renegotiation.

The following fields can be queried:

=over 8

=item authority (alias issuer)

The certificate authority which signed the certificate.

=item owner (alias subject)

The owner of the certificate.

=item commonName (alias cn) - only for Net::SSLeay version >=1.30

The common name, usually the server name for SSL certificates.

=item subjectAltNames - only for Net::SSLeay version >=1.33

Alternative names for the subject, usually different names for the same
server, like example.org, example.com, *.example.com.

It returns a list of (typ,value) with typ GEN_DNS, GEN_IPADD etc (these
constants are exported from IO::Socket::SSL).
See Net::SSLeay::X509_get_subjectAltNames.

=back

=item B<sock_certificate($field)>

This is similar to C<peer_certificate> but will return the sites own
certificate. The same arguments for B<$field> can be used.
If no B<$field> is given the certificate handle from the underlying OpenSSL will
be returned. This handle will only be valid as long as the SSL connection exists
and if used afterwards it might result in strange crashes of the application.

=item B<peer_certificates>

This returns all the certificates send by the peer, e.g. first the peers own
certificate and then the rest of the chain. You might use B<CERT_asHash> from
L<IO::Socket::SSL::Utils> to inspect each of the certificates.

This function depends on a version of Net::SSLeay >= 1.58 .

=item B<get_servername>

This gives the name requested by the client if Server Name Indication
(SNI) was used.

=item B<verify_hostname($hostname,$scheme,$publicsuffix)>

This verifies the given hostname against the peer certificate using the
given scheme. Hostname is usually what you specify within the PeerAddr.
See the C<SSL_verifycn_publicsuffix> parameter for an explanation of suffix
checking and for the possible values.

Verification of hostname against a certificate is different between various
applications and RFCs. Some scheme allow wildcards for hostnames, some only
in subjectAltNames, and even their different wildcard schemes are possible.
RFC 6125 provides a good overview.

To ease the verification the following schemes are predefined (both protocol
name and rfcXXXX name can be used):

=over 8

=item rfc2818, xmpp (rfc3920), ftp (rfc4217)

Extended wildcards in subjectAltNames and common name are possible, e.g.
*.example.org or even www*.example.org. The common
name will be only checked if no DNS names are given in subjectAltNames.

=item http (alias www)

While name checking is defined in rfc2818 the current browsers usually accept
also an IP address (w/o wildcards) within the common name as long as no
subjectAltNames are defined. Thus this is rfc2818 extended with this feature.

=item smtp (rfc2595), imap, pop3, acap (rfc4642), netconf (rfc5538), syslog (rfc5425), snmp (rfc5953)

Simple wildcards in subjectAltNames are possible, e.g. *.example.org matches
www.example.org but not lala.www.example.org. If nothing from subjectAltNames
match it checks against the common name, where wildcards are also allowed to
match the full leftmost label.

=item ldap (rfc4513)

Simple wildcards are allowed in subjectAltNames, but not in common name.
Common name will be checked even if subjectAltNames exist.

=item sip (rfc5922)

No wildcards are allowed and common name is checked even if subjectAltNames
exist.

=item gist (rfc5971)

Simple wildcards are allowed in subjectAltNames and common name, but common name
will only be checked if their are no DNS names in subjectAltNames.

=item default

This is a superset of all the rules and is automatically used if no scheme is
given but a hostname (instead of IP) is known.
Extended wildcards are allowed in subjectAltNames and common name and common
name is checked always.

=item none

No verification will be done.
Actually is does not make any sense to call verify_hostname in this case.

=back

The scheme can be given either by specifying the name for one of the above
predefined schemes, or by using a hash which can have the following keys and
values:

=over 8

=item check_cn:  0|'always'|'when_only'

Determines if the common name gets checked. If 'always' it will always be
checked (like in ldap), if 'when_only' it will only be checked if no names are
given in subjectAltNames (like in http), for any other values the common name
will not be checked.

=item wildcards_in_alt: 0|'full_label'|'anywhere'

Determines if and where wildcards in subjectAltNames are possible. If
'full_label' only cases like *.example.org will be possible (like in ldap), for
'anywhere' www*.example.org is possible too (like http), dangerous things like
but www.*.org or even '*' will not be allowed.
For compatibility with older versions 'leftmost' can be given instead of
'full_label'.

=item wildcards_in_cn: 0|'full_label'|'anywhere'

Similar to wildcards_in_alt, but checks the common name. There is no predefined
scheme which allows wildcards in common names.

=item ip_in_cn: 0|1|4|6

Determines if an IP address is allowed in the common name (no wildcards are
allowed). If set to 4 or 6 it only allows IPv4 or IPv6 addresses, any other
true value allows both.

=item callback: \&coderef

If you give a subroutine for verification it will be called with the arguments
($hostname,$commonName,@subjectAltNames), where hostname is the name given for
verification, commonName is the result from peer_certificate('cn') and
subjectAltNames is the result from peer_certificate('subjectAltNames').

All other arguments for the verification scheme will be ignored in this case.

=back

=item B<next_proto_negotiated()>

This method returns the name of negotiated protocol - e.g. 'http/1.1'. It works
for both client and server side of SSL connection.

NPN support is available with Net::SSLeay 1.46+ and openssl-1.0.1+.
To check support you might call C<< IO::Socket::SSL->can_npn() >>.

=item B<alpn_selected()>

Returns the protocol negotiated via ALPN as a string, e.g. 'http/1.1',
'http/2.0' or 'spdy/3.1'.

ALPN support is available with Net::SSLeay 1.56+ and openssl-1.0.2+.
To check support, use C<< IO::Socket::SSL->can_alpn() >>.

=item B<errstr()>

Returns the last error (in string form) that occurred.	If you do not have a
real object to perform this method on, call IO::Socket::SSL::errstr() instead.

For read and write errors on non-blocking sockets, this method may include the
string C<SSL wants a read first!> or C<SSL wants a write first!> meaning that
the other side is expecting to read from or write to the socket and wants to be
satisfied before you get to do anything. But with version 0.98 you are better
comparing the global exported variable $SSL_ERROR against the exported symbols
SSL_WANT_READ and SSL_WANT_WRITE.

=item B<opened()>

This returns false if the socket could not be opened, 1 if the socket could be
opened and the SSL handshake was successful done and -1 if the underlying
IO::Handle is open, but the SSL handshake failed.

=item B<< IO::Socket::SSL->start_SSL($socket, ... ) >>

This will convert a glob reference or a socket that you provide to an
IO::Socket::SSL object.	 You may also pass parameters to specify context or
connection options as with a call to new().  If you are using this function on
an accept()ed socket, you must set the parameter "SSL_server" to 1, i.e.
IO::Socket::SSL->start_SSL($socket, SSL_server => 1).  If you have a class that
inherits from IO::Socket::SSL and you want the $socket to be blessed into your
own class instead, use MyClass->start_SSL($socket) to achieve the desired
effect.

Note that if start_SSL() fails in SSL negotiation, $socket will remain blessed
in its original class.	 For non-blocking sockets you better just upgrade the
socket to IO::Socket::SSL and call accept_SSL or connect_SSL and the upgraded
object. To just upgrade the socket set B<SSL_startHandshake> explicitly to 0. If
you call start_SSL w/o this parameter it will revert to blocking behavior for
accept_SSL and connect_SSL.

If given the parameter "Timeout" it will stop if after the timeout no SSL
connection was established. This parameter is only used for blocking sockets, if
it is not given the default Timeout from the underlying IO::Socket will be
used.

=item B<stop_SSL(...)>

This is the opposite of start_SSL(), connect_SSL() and accept_SSL(), e.g. it
will shutdown the SSL connection and return to the class before start_SSL(). It
gets the same arguments as close(), in fact close() calls stop_SSL() (but
without downgrading the class).

Will return true if it succeeded and undef if failed. This might be the case for
non-blocking sockets. In this case $! is set to EWOULDBLOCK and the ssl error to
SSL_WANT_READ or SSL_WANT_WRITE. In this case the call should be retried again
with the same arguments once the socket is ready.

For calling from C<stop_SSL> C<SSL_fast_shutdown> default to false, e.g. it
waits for the close_notify of the peer. This is necessary in case you want to
downgrade the socket and continue to use it as a plain socket.

After stop_SSL the socket can again be used to exchange plain data.

=item B<connect_SSL>, B<accept_SSL>

These functions should be used to do the relevant handshake, if the socket got
created with C<new> or upgraded with C<start_SSL> and C<SSL_startHandshake> was
set to false.
They will return undef until the handshake succeeded or an error got thrown.
As long as the function returns undef and $! is set to EWOULDBLOCK one could
retry the call after the socket got readable (SSL_WANT_READ) or writeable
(SSL_WANT_WRITE).

=item B<ocsp_resolver>

This will create an OCSP resolver object, which can be used to create OCSP
requests for the certificates of the SSL connection. Which certificates are
verified depends on the setting of C<SSL_ocsp_mode>: by default only the leaf
certificate will be checked, but with SSL_OCSP_FULL_CHAIN all chain
certificates will be checked.

Because to create an OCSP request the certificate and its issuer certificate
need to be known it is not possible to check certificates when the trust chain
is incomplete or if the certificate is self-signed.

The OCSP resolver gets created by calling C<< $ssl->ocsp_resolver >> and
provides the following methods:

=over 8

=item hard_error

This returns the hard error when checking the OCSP response.
Hard errors are certificate revocations. With the C<SSL_ocsp_mode> of
SSL_OCSP_FAIL_HARD any soft error (e.g. failures to get signed information
about the certificates) will be considered a hard error too.

The OCSP resolving will stop on the first hard error.

The method will return undef as long as no hard errors occurred and still
requests to be resolved. If all requests got resolved and no hard errors
occurred the method will return C<''>.

=item soft_error

This returns the soft error(s) which occurred when asking the OCSP responders.

=item requests

This will return a hash consisting of C<(url,request)>-tuples, e.g. which
contain the OCSP request string and the URL where it should be sent too. The
usual way to send such a request is as HTTP POST request with a content-type
of C<application/ocsp-request> or as a GET request with the base64 and
url-encoded request is added to the path of the URL.

After you've handled all these requests and added the response with
C<add_response> you should better call this method again to make sure, that no
more requests are outstanding. IO::Socket::SSL will combine multiple OCSP
requests for the same server inside a single request, but some server don't
give a response to all these requests, so that one has to ask again with the
remaining requests.

=item add_response($uri,$response)

This method takes the HTTP body of the response which got received when sending
the OCSP request to C<$uri>. If no response was received or an error occurred
one should either retry or consider C<$response> as empty which will trigger a
soft error.

The method returns the current value of C<hard_error>, e.g. a defined value
when no more requests need to be done.

=item resolve_blocking(%args)

This combines C<requests> and C<add_response> which L<HTTP::Tiny> to do all
necessary requests in a blocking way. C<%args> will be given to L<HTTP::Tiny>
so that you can put proxy settings etc here. L<HTTP::Tiny> will be called with
C<verify_SSL> of false, because the OCSP responses have their own signatures so
no extra SSL verification is needed.

If you don't want to use blocking requests you need to roll your own user agent
with C<requests> and C<add_response>.

=back

=item B<< IO::Socket::SSL->new_from_fd($fd, [mode], %sslargs) >>

This will convert a socket identified via a file descriptor into an SSL socket.
Note that the argument list does not include a "MODE" argument; if you supply
one, it will be thoughtfully ignored (for compatibility with IO::Socket::INET).
Instead, a mode of '+<' is assumed, and the file descriptor passed must be able
to handle such I/O because the initial SSL handshake requires bidirectional
communication.

Internally the given $fd will be upgraded to a socket object using the
C<new_from_fd> method of the super class (L<IO::Socket::INET> or similar) and
then C<start_SSL> will be called using the given C<%sslargs>.
If C<$fd> is already an IO::Socket object you should better call C<start_SSL>
directly.

=item B<IO::Socket::SSL::default_ca([ path|dir| SSL_ca_file => ..., SSL_ca_path => ... ])>

Determines or sets the default CA path.
If existing path or dir or a hash is given it will set the default CA path to
this value and never try to detect it automatically.
If C<undef> is given it will forget any stored defaults and continue with
detection of system defaults.
If no arguments are given it will start detection of system defaults, unless it
has already stored user-set or previously detected values.

The detection of system defaults works similar to OpenSSL, e.g. it will check
the directory specified in environment variable SSL_CERT_DIR or the path
OPENSSLDIR/certs (SSLCERTS: on VMS) and the file specified in environment
variable SSL_CERT_FILE or the path OPENSSLDIR/cert.pem (SSLCERTS:cert.pem on
VMS). Contrary to OpenSSL it will check if the SSL_ca_path contains PEM files
with the hash as file name and if the SSL_ca_file looks like PEM.
If no usable system default can be found it will try to load and use
L<Mozilla::CA> and if not available give up detection.
The result of the detection will be saved to speed up future calls.

The function returns the saved default CA as hash with SSL_ca_file and
SSL_ca_path.

=item B<IO::Socket::SSL::set_default_context(...)>

You may use this to make IO::Socket::SSL automatically re-use a given context
(unless specifically overridden in a call to new()).
It accepts one argument, which should be either an IO::Socket::SSL object or an
IO::Socket::SSL::SSL_Context object.
See the SSL_reuse_ctx option of new() for more details.
Note that this sets the default context globally, so use with caution (esp. in
mod_perl scripts).

=item B<IO::Socket::SSL::set_default_session_cache(...)>

You may use this to make IO::Socket::SSL automatically re-use a given session
cache (unless specifically overridden in a call to new()).
It accepts one argument, which should be an IO::Socket::SSL::Session_Cache
object or similar (e.g. something which implements get_session, add_session and
del_session like IO::Socket::SSL::Session_Cache does).
See the SSL_session_cache option of new() for more details.
Note that this sets the default cache globally, so use with caution.

=item B<IO::Socket::SSL::set_defaults(%args)>

With this function one can set defaults for all SSL_* parameter used for
creation of the context, like the SSL_verify* parameter. Any SSL_* parameter can
be given or the following short versions:

=over 8

=item mode - SSL_verify_mode

=item callback - SSL_verify_callback

=item scheme - SSL_verifycn_scheme

=item name - SSL_verifycn_name

=back

=item B<IO::Socket::SSL::set_client_defaults(%args)>

Similar to C<set_defaults>, but only sets the defaults for client mode.

=item B<IO::Socket::SSL::set_server_defaults(%args)>

Similar to C<set_defaults>, but only sets the defaults for server mode.

=item B<IO::Socket::SSL::set_args_filter_hack(\&code|'use_defaults')>

Sometimes one has to use code which uses unwanted or invalid arguments for SSL,
typically disabling SSL verification or setting wrong ciphers or SSL versions.
With this hack it is possible to override these settings and restore sanity.
Example:

    IO::Socket::SSL::set_args_filter_hack( sub {
	my ($is_server,$args) = @_;
	if ( ! $is_server ) {
	    # client settings - enable verification with default CA
	    # and fallback hostname verification etc
	    delete @{$args}{qw(
		SSL_verify_mode
		SSL_ca_file
		SSL_ca_path
		SSL_verifycn_scheme
		SSL_version
	    )};
	    # and add some fingerprints for known certs which are signed by
	    # unknown CAs or are self-signed
	    $args->{SSL_fingerprint} = ...
	}
    });

With the short setting C<set_args_filter_hack('use_defaults')> it will prefer
the default settings in all cases. These default settings can be modified with
C<set_defaults>, C<set_client_defaults> and C<set_server_defaults>.

=back

The following methods are unsupported (not to mention futile!) and
IO::Socket::SSL will emit a large CROAK() if you are silly enough to use them:

=over 4

=item truncate

=item stat

=item ungetc

=item setbuf

=item setvbuf

=item fdopen

=item send/recv

Note that send() and recv() cannot be reliably trapped by a tied filehandle
(such as that used by IO::Socket::SSL) and so may send unencrypted data over the
socket.	 Object-oriented calls to these functions will fail, telling you to use
the print/printf/syswrite and read/sysread families instead.

=back

=head1 DEPRECATIONS

The following functions are deprecated and are only retained for compatibility:

=over 2

=item context_init()

use the SSL_reuse_ctx option if you want to re-use a context

=item socketToSSL() and socket_to_SSL()

use IO::Socket::SSL->start_SSL() instead

=item kill_socket()

use close() instead

=item get_peer_certificate()

use the peer_certificate() function instead.
Used to return X509_Certificate with methods subject_name and issuer_name.
Now simply returns $self which has these methods (although deprecated).

=item issuer_name()

use peer_certificate( 'issuer' ) instead

=item subject_name()

use peer_certificate( 'subject' ) instead

=back


=head1 EXAMPLES

See the 'example' directory, the tests in 't' and also the tools in 'util'.


=head1 BUGS

If you use IO::Socket::SSL together with threads you should load it (e.g. use or
require) inside the main thread before creating any other threads which use it.
This way it is much faster because it will be initialized only once. Also there
are reports that it might crash the other way.

Creating an IO::Socket::SSL object in one thread and closing it in another
thread will not work.

IO::Socket::SSL does not work together with Storable::fd_retrieve/fd_store.
See BUGS file for more information and how to work around the problem.

Non-blocking and timeouts (which are based on non-blocking) are not
supported on Win32, because the underlying IO::Socket::INET does not support
non-blocking on this platform.

If you have a server and it looks like you have a memory leak you might
check the size of your session cache. Default for Net::SSLeay seems to be
20480, see the example for SSL_create_ctx_callback for how to limit it.

TLS 1.3 support regarding session reuse is incomplete.

=head1 SEE ALSO

IO::Socket::INET, IO::Socket::INET6, IO::Socket::IP, Net::SSLeay.


=head1 THANKS

Many thanks to all who added patches or reported bugs or helped IO::Socket::SSL
another way. Please keep reporting bugs and help with patches, even if they just
fix the documentation.

Special thanks to the team of Net::SSLeay for the good cooperation.

=head1 AUTHORS

Steffen Ullrich, <sullr at cpan.org> is the current maintainer.

Peter Behroozi, <behrooz at fas.harvard.edu> (Note the lack of an "i" at the end of "behrooz")

Marko Asplund, <marko.asplund at kronodoc.fi>, was the original author of IO::Socket::SSL.

Patches incorporated from various people, see file Changes.


=head1 COPYRIGHT

The original versions of this module are Copyright (C) 1999-2002 Marko Asplund.

The rewrite of this module is Copyright (C) 2002-2005 Peter Behroozi.

Versions 0.98 and newer are Copyright (C) 2006-2014 Steffen Ullrich.

This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
                       Socket/SSL.pm                                                                                       0000644                 00000322342 00000000000 0006742 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       #vim: set sts=4 sw=4 ts=8 ai:
#
# IO::Socket::SSL:
# provide an interface to SSL connections similar to IO::Socket modules
#
# Current Code Shepherd: Steffen Ullrich <sullr at cpan.org>
# Code Shepherd before: Peter Behroozi, <behrooz at fas.harvard.edu>
#
# The original version of this module was written by
# Marko Asplund, <marko.asplund at kronodoc.fi>, who drew from
# Crypt::SSLeay (Net::SSL) by Gisle Aas.
#

package IO::Socket::SSL;

our $VERSION = '2.074';

use IO::Socket;
use Net::SSLeay 1.46;
use IO::Socket::SSL::PublicSuffix;
use Exporter ();
use Errno qw( EWOULDBLOCK EAGAIN ETIMEDOUT EINTR EPIPE );
use Carp;
use strict;

my $use_threads;
BEGIN {
    die "no support for weaken - please install Scalar::Util" if ! do {
	local $SIG{__DIE__};
	eval { require Scalar::Util; Scalar::Util->import("weaken"); 1 }
	    || eval { require WeakRef; WeakRef->import("weaken"); 1 }
    };
    require Config;
    $use_threads = $Config::Config{usethreads};
}


# results from commonly used constant functions from Net::SSLeay for fast access
my $Net_SSLeay_ERROR_WANT_READ   = Net::SSLeay::ERROR_WANT_READ();
my $Net_SSLeay_ERROR_WANT_WRITE  = Net::SSLeay::ERROR_WANT_WRITE();
my $Net_SSLeay_ERROR_SYSCALL     = Net::SSLeay::ERROR_SYSCALL();
my $Net_SSLeay_ERROR_SSL         = Net::SSLeay::ERROR_SSL();
my $Net_SSLeay_VERIFY_NONE       = Net::SSLeay::VERIFY_NONE();
my $Net_SSLeay_VERIFY_PEER       = Net::SSLeay::VERIFY_PEER();


use constant SSL_VERIFY_NONE => &Net::SSLeay::VERIFY_NONE;
use constant SSL_VERIFY_PEER => &Net::SSLeay::VERIFY_PEER;
use constant SSL_VERIFY_FAIL_IF_NO_PEER_CERT => Net::SSLeay::VERIFY_FAIL_IF_NO_PEER_CERT();
use constant SSL_VERIFY_CLIENT_ONCE => Net::SSLeay::VERIFY_CLIENT_ONCE();

# from openssl/ssl.h; should be better in Net::SSLeay
use constant SSL_SENT_SHUTDOWN => 1;
use constant SSL_RECEIVED_SHUTDOWN => 2;

use constant SSL_OCSP_NO_STAPLE   => 0b00001;
use constant SSL_OCSP_MUST_STAPLE => 0b00010;
use constant SSL_OCSP_FAIL_HARD   => 0b00100;
use constant SSL_OCSP_FULL_CHAIN  => 0b01000;
use constant SSL_OCSP_TRY_STAPLE  => 0b10000;

# capabilities of underlying Net::SSLeay/openssl
my $can_client_sni;  # do we support SNI on the client side
my $can_server_sni;  # do we support SNI on the server side
my $can_multi_cert;  # RSA and ECC certificate in same context
my $can_npn;         # do we support NPN (obsolete)
my $can_alpn;        # do we support ALPN
my $can_ecdh;        # do we support ECDH key exchange
my $set_groups_list; # SSL_CTX_set1_groups_list || SSL_CTX_set1_curves_list || undef
my $can_ocsp;        # do we support OCSP
my $can_ocsp_staple; # do we support OCSP stapling
my $can_tckt_keycb;  # TLS ticket key callback
my $can_pha;         # do we support PHA
my $session_upref;   # SSL_SESSION_up_ref is implemented
my %sess_cb;         # SSL_CTX_sess_set_(new|remove)_cb
my $check_partial_chain; # use X509_V_FLAG_PARTIAL_CHAIN if available
my $auto_retry;      # (clear|set)_mode SSL_MODE_AUTO_RETRY with OpenSSL 1.1.1+ with non-blocking
my $ssl_mode_release_buffers = 0; # SSL_MODE_RELEASE_BUFFERS if available
my $can_ciphersuites; # support for SSL_CTX_set_ciphersuites (TLS 1.3)

my $openssl_version;
my $netssleay_version;

BEGIN {
    $openssl_version = Net::SSLeay::OPENSSL_VERSION_NUMBER();
    $netssleay_version = do { no warnings; $Net::SSLeay::VERSION + 0.0; };
    $can_client_sni = $openssl_version >= 0x10000000;
    $can_server_sni = defined &Net::SSLeay::get_servername;
    $can_npn = defined &Net::SSLeay::P_next_proto_negotiated &&
	! Net::SSLeay::constant("LIBRESSL_VERSION_NUMBER");
	# LibreSSL 2.6.1 disabled NPN by keeping the relevant functions
	# available but removed the actual functionality from these functions.
    $can_alpn = defined &Net::SSLeay::CTX_set_alpn_protos;
    $can_ecdh =
	($openssl_version >= 0x1010000f) ? 'auto' :
	defined(&Net::SSLeay::CTX_set_ecdh_auto) ? 'can_auto' :
	(defined &Net::SSLeay::CTX_set_tmp_ecdh &&
	    # There is a regression with elliptic curves on 1.0.1d with 64bit
	    # http://rt.openssl.org/Ticket/Display.html?id=2975
	    ( $openssl_version != 0x1000104f
	    || length(pack("P",0)) == 4 )) ? 'tmp_ecdh' :
	    '';
    $set_groups_list =
	defined &Net::SSLeay::CTX_set1_groups_list ? \&Net::SSLeay::CTX_set1_groups_list :
	defined &Net::SSLeay::CTX_set1_curves_list ? \&Net::SSLeay::CTX_set1_curves_list :
	undef;
    $can_multi_cert = $can_ecdh
	&& $openssl_version >= 0x10002000;
    $can_ocsp = defined &Net::SSLeay::OCSP_cert2ids
	# OCSP got broken in 1.75..1.77
	&& ($netssleay_version < 1.75 || $netssleay_version > 1.77);
    $can_ocsp_staple = $can_ocsp
	&& defined &Net::SSLeay::set_tlsext_status_type;
    $can_tckt_keycb  = defined &Net::SSLeay::CTX_set_tlsext_ticket_getkey_cb
	&& $netssleay_version >= 1.80;
    $can_pha = defined &Net::SSLeay::CTX_set_post_handshake_auth;
    $can_ciphersuites = defined &Net::SSLeay::CTX_set_ciphersuites;

    if (defined &Net::SSLeay::SESSION_up_ref) {
	$session_upref = 1;
    }

    if ($session_upref
	&& defined &Net::SSLeay::CTX_sess_set_new_cb
	&& defined &Net::SSLeay::CTX_sess_set_remove_cb) {
	%sess_cb = (
	    new => \&Net::SSLeay::CTX_sess_set_new_cb,
	    remove => \&Net::SSLeay::CTX_sess_set_remove_cb,
	);
    }

    if (my $c = defined &Net::SSLeay::CTX_get0_param
	&& eval { Net::SSLeay::X509_V_FLAG_PARTIAL_CHAIN() }) {
	$check_partial_chain = sub {
	    my $ctx = shift;
	    my $param = Net::SSLeay::CTX_get0_param($ctx);
	    Net::SSLeay::X509_VERIFY_PARAM_set_flags($param, $c);
	};
    }

    if (!defined &Net::SSLeay::clear_mode) {
	# assume SSL_CTRL_CLEAR_MODE being 78 since it was always this way
	*Net::SSLeay::clear_mode = sub {
	    my ($ctx,$opt) = @_;
	    Net::SSLeay::ctrl($ctx,78,$opt,0);
	};
    }

    if ($openssl_version >= 0x10101000) {
	# openssl 1.1.1 enabled SSL_MODE_AUTO_RETRY by default, which is bad for
	# non-blocking sockets
	my $mode_auto_retry =
	    # was always 0x00000004
	    eval { Net::SSLeay::MODE_AUTO_RETRY() } || 0x00000004;
	$auto_retry = sub {
	    my ($ssl,$on) = @_;
	    if ($on) {
		Net::SSLeay::set_mode($ssl, $mode_auto_retry);
	    } else {
		Net::SSLeay::clear_mode($ssl, $mode_auto_retry);
	    }
	}
    }
    if ($openssl_version >= 0x10000000) {
	# ssl/ssl.h:#define SSL_MODE_RELEASE_BUFFERS 0x00000010L
	$ssl_mode_release_buffers = 0x00000010;
    }
}

my $algo2digest = do {
    my %digest;
    sub {
	my $digest_name = shift;
	return $digest{$digest_name} ||= do {
	    Net::SSLeay::SSLeay_add_ssl_algorithms();
	    Net::SSLeay::EVP_get_digestbyname($digest_name)
		or die "Digest algorithm $digest_name is not available";
	};
    }
};

my $CTX_tlsv1_3_new;
if ( defined &Net::SSLeay::CTX_set_min_proto_version
    and defined &Net::SSLeay::CTX_set_max_proto_version
    and my $tls13 = eval { Net::SSLeay::TLS1_3_VERSION() }
) {
    $CTX_tlsv1_3_new = sub {
	my $ctx = Net::SSLeay::CTX_new();
	return $ctx if Net::SSLeay::CTX_set_min_proto_version($ctx,$tls13)
	    && Net::SSLeay::CTX_set_max_proto_version($ctx,$tls13);
	Net::SSLeay::CTX_free($ctx);
	return;
    };
}


# global defaults
my %DEFAULT_SSL_ARGS = (
    SSL_check_crl => 0,
    SSL_version => 'SSLv23:!SSLv3:!SSLv2', # consider both SSL3.0 and SSL2.0 as broken
    SSL_verify_callback => undef,
    SSL_verifycn_scheme => undef,  # fallback cn verification
    SSL_verifycn_publicsuffix => undef,  # fallback default list verification
    #SSL_verifycn_name => undef,   # use from PeerAddr/PeerHost - do not override in set_args_filter_hack 'use_defaults'
    SSL_npn_protocols => undef,    # meaning depends whether on server or client side
    SSL_alpn_protocols => undef,   # list of protocols we'll accept/send, for example ['http/1.1','spdy/3.1']

    # rely on system default but be sure to disable some definitely bad ones
    SSL_cipher_list => 'DEFAULT !EXP !MEDIUM !LOW !eNULL !aNULL !RC4 !DES !MD5 !PSK !SRP',
);

my %DEFAULT_SSL_CLIENT_ARGS = (
    %DEFAULT_SSL_ARGS,
    SSL_verify_mode => SSL_VERIFY_PEER,

    SSL_ca_file => undef,
    SSL_ca_path => undef,
);

# set values inside _init to work with perlcc, RT#95452
my %DEFAULT_SSL_SERVER_ARGS;

# Initialization of OpenSSL internals
# This will be called once during compilation - perlcc users might need to
# call it again by hand, see RT#95452
{
    sub init {
	# library_init returns false if the library was already initialized.
	# This way we can find out if the library needs to be re-initialized
	# inside code compiled with perlcc
	Net::SSLeay::library_init() or return;

	Net::SSLeay::load_error_strings();
	Net::SSLeay::OpenSSL_add_all_digests();
	Net::SSLeay::randomize();

	%DEFAULT_SSL_SERVER_ARGS = (
	    %DEFAULT_SSL_ARGS,
	    SSL_verify_mode => SSL_VERIFY_NONE,
	    SSL_honor_cipher_order => 1,  # trust server to know the best cipher
	    SSL_dh => do {
		my $bio = Net::SSLeay::BIO_new(Net::SSLeay::BIO_s_mem());
		# generated with: openssl dhparam 2048
		Net::SSLeay::BIO_write($bio,<<'DH');
-----BEGIN DH PARAMETERS-----
MIIBCAKCAQEAr8wskArj5+1VCVsnWt/RUR7tXkHJ7mGW7XxrLSPOaFyKyWf8lZht
iSY2Lc4oa4Zw8wibGQ3faeQu/s8fvPq/aqTxYmyHPKCMoze77QJHtrYtJAosB9SY
CN7s5Hexxb5/vQ4qlQuOkVrZDiZO9GC4KaH9mJYnCoAsXDhDft6JT0oRVSgtZQnU
gWFKShIm+JVjN94kGs0TcBEesPTK2g8XVHK9H8AtSUb9BwW2qD/T5RmgNABysApO
Ps2vlkxjAHjJcqc3O+OiImKik/X2rtBTZjpKmzN3WWTB0RJZCOWaLlDO81D01o1E
aZecz3Np9KIYey900f+X7zC2bJxEHp95ywIBAg==
-----END DH PARAMETERS-----
DH
		my $dh = Net::SSLeay::PEM_read_bio_DHparams($bio);
		Net::SSLeay::BIO_free($bio);
		$dh or die "no DH";
		$dh;
	    },
	    (
		$can_ecdh eq 'auto' ? () : # automatically enabled by openssl
		$can_ecdh eq 'can_auto' ? (SSL_ecdh_curve => 'auto') :
		$can_ecdh eq 'tmp_ecdh' ? ( SSL_ecdh_curve => 'prime256v1' ) :
		(),
	    )
	);
    }
    # Call it once at compile time and try it at INIT.
    # This should catch all cases of including the module, e.g. 'use' (INIT) or
    # 'require' (compile time) and works also with perlcc
    {
	no warnings;
	INIT { init() }
	init();
    }
}

# global defaults which can be changed using set_defaults
# either key/value can be set or it can just be set to an external hash
my $GLOBAL_SSL_ARGS = {};
my $GLOBAL_SSL_CLIENT_ARGS = {};
my $GLOBAL_SSL_SERVER_ARGS = {};

# hack which is used to filter bad settings from used modules
my $FILTER_SSL_ARGS = undef;

# non-XS Versions of Scalar::Util will fail
BEGIN{
    die "You need the XS Version of Scalar::Util for dualvar() support" if !do {
	local $SIG{__DIE__}; local $SIG{__WARN__}; # be silent
	eval { use Scalar::Util 'dualvar'; dualvar(0,''); 1 };
    };
}

# get constants for SSL_OP_NO_* now, instead calling the related functions
# every time we setup a connection
my %SSL_OP_NO;
for(qw( SSLv2 SSLv3 TLSv1 TLSv1_1 TLSv11:TLSv1_1 TLSv1_2 TLSv12:TLSv1_2
	TLSv1_3 TLSv13:TLSv1_3 )) {
    my ($k,$op) = m{:} ? split(m{:},$_,2) : ($_,$_);
    my $sub = "Net::SSLeay::OP_NO_$op";
    local $SIG{__DIE__};
    $SSL_OP_NO{$k} = eval { no strict 'refs'; &$sub } || 0;
}

# Make SSL_CTX_clear_options accessible through SSL_CTX_ctrl unless it is
# already implemented in Net::SSLeay
if (!defined &Net::SSLeay::CTX_clear_options) {
    *Net::SSLeay::CTX_clear_options = sub {
	my ($ctx,$opt) = @_;
	# 77 = SSL_CTRL_CLEAR_OPTIONS
	Net::SSLeay::CTX_ctrl($ctx,77,$opt,0);
    };
}

# Try to work around problems with alternative trust path by default, RT#104759
my $DEFAULT_X509_STORE_flags = 0;
{
    local $SIG{__DIE__};
    eval { $DEFAULT_X509_STORE_flags |= Net::SSLeay::X509_V_FLAG_TRUSTED_FIRST() };
}

our $DEBUG;
use vars qw(@ISA $SSL_ERROR @EXPORT);

{
    # These constants will be used in $! at return from SSL_connect,
    # SSL_accept, _generic_(read|write), thus notifying the caller
    # the usual way of problems. Like with EWOULDBLOCK, EINPROGRESS..
    # these are especially important for non-blocking sockets

    my $x = $Net_SSLeay_ERROR_WANT_READ;
    use constant SSL_WANT_READ  => dualvar( \$x, 'SSL wants a read first' );
    my $y = $Net_SSLeay_ERROR_WANT_WRITE;
    use constant SSL_WANT_WRITE => dualvar( \$y, 'SSL wants a write first' );

    @EXPORT = qw(
	SSL_WANT_READ SSL_WANT_WRITE SSL_VERIFY_NONE SSL_VERIFY_PEER
	SSL_VERIFY_FAIL_IF_NO_PEER_CERT SSL_VERIFY_CLIENT_ONCE
	SSL_OCSP_NO_STAPLE SSL_OCSP_TRY_STAPLE SSL_OCSP_MUST_STAPLE
	SSL_OCSP_FAIL_HARD SSL_OCSP_FULL_CHAIN
	$SSL_ERROR GEN_DNS GEN_IPADD
    );
}

my @caller_force_inet4; # in case inet4 gets forced we store here who forced it

my $IOCLASS;
my $family_key; # 'Domain'||'Family'
BEGIN {
    # declare @ISA depending of the installed socket class

    # try to load inet_pton from Socket or Socket6 and make sure it is usable
    local $SIG{__DIE__}; local $SIG{__WARN__}; # be silent
    my $ip6 = eval {
	require Socket;
	Socket->VERSION(1.95);
	Socket::inet_pton( AF_INET6(),'::1') && AF_INET6() or die;
	Socket->import( qw/inet_pton NI_NUMERICHOST NI_NUMERICSERV/ );
	# behavior different to Socket6::getnameinfo - wrap
	*_getnameinfo = sub {
	    my ($err,$host,$port) = Socket::getnameinfo(@_) or return;
	    return if $err;
	    return ($host,$port);
	};
	'Socket';
    } || eval {
	require Socket6;
	Socket6::inet_pton( AF_INET6(),'::1') && AF_INET6() or die;
	Socket6->import( qw/inet_pton NI_NUMERICHOST NI_NUMERICSERV/ );
	# behavior different to Socket::getnameinfo - wrap
	*_getnameinfo = sub { return Socket6::getnameinfo(@_); };
	'Socket6';
    } || undef;

    # try IO::Socket::IP or IO::Socket::INET6 for IPv6 support
    $family_key = 'Domain'; # traditional
    if ($ip6) {
	# if we have IO::Socket::IP >= 0.31 we will use this in preference
	# because it can handle both IPv4 and IPv6
	if ( eval {
	    require IO::Socket::IP;
	    IO::Socket::IP->VERSION(0.31)
	}) {
	    @ISA = qw(IO::Socket::IP);
	    constant->import( CAN_IPV6 => "IO::Socket::IP" );
	    $family_key = 'Family';
	    $IOCLASS = "IO::Socket::IP";

	# if we have IO::Socket::INET6 we will use this not IO::Socket::INET
	# because it can handle both IPv4 and IPv6
	# require at least 2.62 because of several problems before that version
	} elsif( eval { require IO::Socket::INET6; IO::Socket::INET6->VERSION(2.62) } ) {
	    @ISA = qw(IO::Socket::INET6);
	    constant->import( CAN_IPV6 => "IO::Socket::INET6" );
	    $IOCLASS = "IO::Socket::INET6";
	} else {
	    $ip6 = ''
	}
    }

    # fall back to IO::Socket::INET for IPv4 only
    if (!$ip6) {
	@ISA = qw(IO::Socket::INET);
	$IOCLASS = "IO::Socket::INET";
	constant->import(CAN_IPV6 => '');
	if (!defined $ip6) {
	    constant->import(NI_NUMERICHOST => 1);
	    constant->import(NI_NUMERICSERV => 2);
	}
    }

    #Make $DEBUG another name for $Net::SSLeay::trace
    *DEBUG = \$Net::SSLeay::trace;

    #Compatibility
    *ERROR = \$SSL_ERROR;
}


sub DEBUG {
    $DEBUG or return;
    my (undef,$file,$line,$sub) = caller(1);
    if ($sub =~m{^IO::Socket::SSL::(?:error|(_internal_error))$}) {
	(undef,$file,$line) = caller(2) if $1;
    } else {
	(undef,$file,$line) = caller;
    }
    my $msg = shift;
    $file = '...'.substr( $file,-17 ) if length($file)>20;
    $msg = sprintf $msg,@_ if @_;
    print STDERR "DEBUG: $file:$line: $msg\n";
}

BEGIN {
    # import some constants from Net::SSLeay or use hard-coded defaults
    # if Net::SSLeay isn't recent enough to provide the constants
    my %const = (
	NID_CommonName => 13,
	GEN_DNS => 2,
	GEN_IPADD => 7,
    );
    while ( my ($name,$value) = each %const ) {
	no strict 'refs';
	*{$name} = UNIVERSAL::can( 'Net::SSLeay', $name ) || sub { $value };
    }

    *idn_to_ascii = \&IO::Socket::SSL::PublicSuffix::idn_to_ascii;
    *idn_to_unicode = \&IO::Socket::SSL::PublicSuffix::idn_to_unicode;
}

my $OPENSSL_LIST_SEPARATOR = $^O =~m{^(?:(dos|os2|mswin32|netware)|vms)$}i
    ? $1 ? ';' : ',' : ':';
my $CHECK_SSL_PATH = sub {
    my %args = (@_ == 1) ? ('',@_) : @_;
    for my $type (keys %args) {
	my $path = $args{$type};
	if (!$type) {
	    delete $args{$type};
	    $type = (ref($path) || -d $path) ? 'SSL_ca_path' : 'SSL_ca_file';
	    $args{$type} = $path;
	}

	next if ref($path) eq 'SCALAR' && ! $$path;
	if ($type eq 'SSL_ca_file') {
	    die "SSL_ca_file $path can't be used: $!"
		if ! open(my $fh,'<',$path);
	} elsif ($type eq 'SSL_ca_path') {
	    $path = [ split($OPENSSL_LIST_SEPARATOR,$path) ] if !ref($path);
	    my @err;
	    for my $d (ref($path) ? @$path : $path) {
		if (! -d $d) {
		    push @err, "SSL_ca_path $d does not exist";
		} elsif (! opendir(my $dh,$d)) {
		    push @err, "SSL_ca_path $d is not accessible: $!"
		} else {
		    @err = ();
		    last
		}
	    }
	    die "@err" if @err;
	}
    }
    return %args;
};


{
    my %default_ca;
    my $ca_detected; # 0: never detect, undef: need to (re)detect
    my $openssldir;

    sub default_ca {
	if (@_) {
	    # user defined default CA or reset
	    if ( @_ > 1 ) {
		%default_ca = @_;
		$ca_detected  = 0;
	    } elsif ( my $path = shift ) {
		%default_ca = $CHECK_SSL_PATH->($path);
		$ca_detected  = 0;
	    } else {
		$ca_detected = undef;
	    }
	}
	return %default_ca if defined $ca_detected;

	# SSLEAY_DIR was 5 up to OpenSSL 1.1, then switched to 4 and got
	# renamed to OPENSSL_DIR. Unfortunately it is not exported as constant
	# by Net::SSLeay so we use the fixed number.
	$openssldir ||=
	    Net::SSLeay::SSLeay_version(5) =~m{^OPENSSLDIR: "(.+)"$} ? $1 :
	    Net::SSLeay::SSLeay_version(4) =~m{^OPENSSLDIR: "(.+)"$} ? $1 :
	    'cannot-determine-openssldir-from-ssleay-version';

	# (re)detect according to openssl crypto/cryptlib.h
	my $dir = $ENV{SSL_CERT_DIR}
	    || ( $^O =~m{vms}i ? "SSLCERTS:":"$openssldir/certs" );
	if ( opendir(my $dh,$dir)) {
	    FILES: for my $f (  grep { m{^[a-f\d]{8}(\.\d+)?$} } readdir($dh) ) {
		open( my $fh,'<',"$dir/$f") or next;
		while (my $line = <$fh>) {
		    $line =~m{^-+BEGIN (X509 |TRUSTED |)CERTIFICATE-} or next;
		    $default_ca{SSL_ca_path} = $dir;
		    last FILES;
		}
	    }
	}
	my $file = $ENV{SSL_CERT_FILE}
	    || ( $^O =~m{vms}i ? "SSLCERTS:cert.pem":"$openssldir/cert.pem" );
	if ( open(my $fh,'<',$file)) {
	    while (my $line = <$fh>) {
		$line =~m{^-+BEGIN (X509 |TRUSTED |)CERTIFICATE-} or next;
		$default_ca{SSL_ca_file} = $file;
		last;
	    }
	}

	$default_ca{SSL_ca_file} = Mozilla::CA::SSL_ca_file() if ! %default_ca && do {
		local $SIG{__DIE__};
		eval { require Mozilla::CA; 1 };
	    };

	$ca_detected = 1;
	return %default_ca;
    }
}


# Export some stuff
# inet4|inet6|debug will be handled by myself, everything
# else will be handled the Exporter way
sub import {
    my $class = shift;

    my @export;
    foreach (@_) {
	if ( /^inet4$/i ) {
	    # explicitly fall back to inet4
	    @ISA = 'IO::Socket::INET';
	    @caller_force_inet4 = caller(); # save for warnings for 'inet6' case
	} elsif ( /^inet6$/i ) {
	    # check if we have already ipv6 as base
	    if ( ! UNIVERSAL::isa( $class, 'IO::Socket::INET6')
		and ! UNIVERSAL::isa( $class, 'IO::Socket::IP' )) {
		# either we don't support it or we disabled it by explicitly
		# loading it with 'inet4'. In this case re-enable but warn
		# because this is probably an error
		if ( CAN_IPV6 ) {
		    @ISA = ( CAN_IPV6 );
		    warn "IPv6 support re-enabled in __PACKAGE__, got disabled in file $caller_force_inet4[1] line $caller_force_inet4[2]";
		} else {
		    die "INET6 is not supported, install IO::Socket::IP";
		}
	    }
	} elsif ( /^:?debug(\d+)/ ) {
	    $DEBUG=$1;
	} else {
	    push @export,$_
	}
    }

    @_ = ( $class,@export );
    goto &Exporter::import;
}

my %SSL_OBJECT;
my %CREATED_IN_THIS_THREAD;
sub CLONE { %CREATED_IN_THIS_THREAD = (); }

# all keys used internally, these should be cleaned up at end
my @all_my_keys = qw(
    _SSL_arguments
    _SSL_certificate
    _SSL_ctx
    _SSL_fileno
    _SSL_in_DESTROY
    _SSL_ioclass_downgrade
    _SSL_ioclass_upgraded
    _SSL_last_err
    _SSL_object
    _SSL_ocsp_verify
    _SSL_opened
    _SSL_opening
    _SSL_servername
);


# we have callbacks associated with contexts, but have no way to access the
# current SSL object from these callbacks. To work around this
# CURRENT_SSL_OBJECT will be set before calling Net::SSLeay::{connect,accept}
# and reset afterwards, so we have access to it inside _internal_error.
my $CURRENT_SSL_OBJECT;

# You might be expecting to find a new() subroutine here, but that is
# not how IO::Socket::INET works.  All configuration gets performed in
# the calls to configure() and either connect() or accept().

#Call to configure occurs when a new socket is made using
#IO::Socket::INET.  Returns false (empty list) on failure.
sub configure {
    my ($self, $arg_hash) = @_;
    return _invalid_object() unless($self);

    # force initial blocking
    # otherwise IO::Socket::SSL->new might return undef if the
    # socket is nonblocking and it fails to connect immediately
    # for real nonblocking behavior one should create a nonblocking
    # socket and later call connect explicitly
    my $blocking = delete $arg_hash->{Blocking};

    # because Net::HTTPS simple redefines blocking() to {} (e.g.
    # return undef) and IO::Socket::INET does not like this we
    # set Blocking only explicitly if it was set
    $arg_hash->{Blocking} = 1 if defined ($blocking);

    $self->configure_SSL($arg_hash) || return;

    if ($arg_hash->{$family_key} ||= $arg_hash->{Domain} || $arg_hash->{Family}) {
	# Hack to work around the problem that IO::Socket::IP defaults to
	# AI_ADDRCONFIG which creates problems if we have only the loopback
	# interface. If we already know the family this flag is more harmful
	# then useful.
	$arg_hash->{GetAddrInfoFlags} = 0 if $IOCLASS eq 'IO::Socket::IP'
		&& ! defined $arg_hash->{GetAddrInfoFlags};
    }
    return $self->_internal_error("@ISA configuration failed",0)
	if ! $self->SUPER::configure($arg_hash);

    $self->blocking(0) if defined $blocking && !$blocking;
    return $self;
}

sub configure_SSL {
    my ($self, $arg_hash) = @_;

    $arg_hash->{Proto} ||= 'tcp';
    my $is_server = $arg_hash->{SSL_server};
    if ( ! defined $is_server ) {
	$is_server = $arg_hash->{SSL_server} = $arg_hash->{Listen} || 0;
    }

    # add user defined defaults, maybe after filtering
    $FILTER_SSL_ARGS->($is_server,$arg_hash) if $FILTER_SSL_ARGS;

    delete @{*$self}{@all_my_keys};
    ${*$self}{_SSL_opened} = $is_server;
    ${*$self}{_SSL_arguments} = $arg_hash;

    # this adds defaults to $arg_hash as a side effect!
    ${*$self}{'_SSL_ctx'} = IO::Socket::SSL::SSL_Context->new($arg_hash)
	or return;

    return $self;
}


sub _skip_rw_error {
    my ($self,$ssl,$rv) = @_;
    my $err = Net::SSLeay::get_error($ssl,$rv);
    if ( $err == $Net_SSLeay_ERROR_WANT_READ) {
	$SSL_ERROR = SSL_WANT_READ;
    } elsif ( $err == $Net_SSLeay_ERROR_WANT_WRITE) {
	$SSL_ERROR = SSL_WANT_WRITE;
    } else {
	return $err;
    }
    $! ||= EWOULDBLOCK;
    ${*$self}{_SSL_last_err} = [$SSL_ERROR,4] if ref($self);
    Net::SSLeay::ERR_clear_error();
    return 0;
}


# Call to connect occurs when a new client socket is made using IO::Socket::*
sub connect {
    my $self = shift || return _invalid_object();
    return $self if ${*$self}{'_SSL_opened'};  # already connected

    if ( ! ${*$self}{'_SSL_opening'} ) {
	# call SUPER::connect if the underlying socket is not connected
	# if this fails this might not be an error (e.g. if $! = EINPROGRESS
	# and socket is nonblocking this is normal), so keep any error
	# handling to the client
	$DEBUG>=2 && DEBUG('socket not yet connected' );
	$self->SUPER::connect(@_) || return;
	$DEBUG>=2 && DEBUG('socket connected' );

	# IO::Socket works around systems, which return EISCONN or similar
	# on non-blocking re-connect by returning true, even if $! is set
	# but it does not clear $!, so do it here
	$! = undef;

	# don't continue with connect_SSL if SSL_startHandshake is set to 0
	my $sh = ${*$self}{_SSL_arguments}{SSL_startHandshake};
	return $self if defined $sh && ! $sh;
    }
    return $self->connect_SSL;
}


sub connect_SSL {
    my $self = shift;
    my $args = @_>1 ? {@_}: $_[0]||{};
    return $self if ${*$self}{'_SSL_opened'};  # already connected

    my ($ssl,$ctx);
    if ( ! ${*$self}{'_SSL_opening'} ) {
	# start ssl connection
	$DEBUG>=2 && DEBUG('ssl handshake not started' );
	${*$self}{'_SSL_opening'} = 1;
	my $arg_hash = ${*$self}{'_SSL_arguments'};

	my $fileno = ${*$self}{'_SSL_fileno'} = fileno($self);
	return $self->_internal_error("Socket has no fileno",9)
	    if ! defined $fileno;

	$ctx = ${*$self}{'_SSL_ctx'};  # Reference to real context
	$ssl = ${*$self}{'_SSL_object'} = Net::SSLeay::new($ctx->{context})
	    || return $self->error("SSL structure creation failed");
	$CREATED_IN_THIS_THREAD{$ssl} = 1 if $use_threads;
	$SSL_OBJECT{$ssl} = [$self,0];
	weaken($SSL_OBJECT{$ssl}[0]);

	if ($ctx->{session_cache}) {
	    $arg_hash->{SSL_session_key} ||= do {
		my $host = $arg_hash->{PeerAddr} || $arg_hash->{PeerHost}
		    || $self->_update_peer;
		my $port = $arg_hash->{PeerPort} || $arg_hash->{PeerService};
		$port ? "$host:$port" : $host;
	    }
	}

	Net::SSLeay::set_fd($ssl, $fileno)
	    || return $self->error("SSL filehandle association failed");

	if ( $can_client_sni ) {
	    my $host;
	    if ( exists $arg_hash->{SSL_hostname} ) {
		# explicitly given
		# can be set to undef/'' to not use extension
		$host = $arg_hash->{SSL_hostname}
	    } elsif ( $host = $arg_hash->{PeerAddr} || $arg_hash->{PeerHost} ) {
		# implicitly given
		$host =~s{:[a-zA-Z0-9_\-]+$}{};
		# should be hostname, not IPv4/6
		$host = undef if $host !~m{[a-z_]}i or $host =~m{:};
	    }
	    # define SSL_CTRL_SET_TLSEXT_HOSTNAME 55
	    # define TLSEXT_NAMETYPE_host_name 0
	    if ($host) {
		$DEBUG>=2 && DEBUG("using SNI with hostname $host");
		Net::SSLeay::ctrl($ssl,55,0,$host);
	    } else {
		$DEBUG>=2 && DEBUG("not using SNI because hostname is unknown");
	    }
	} elsif ( $arg_hash->{SSL_hostname} ) {
	    return $self->_internal_error(
		"Client side SNI not supported for this openssl",9);
	} else {
	    $DEBUG>=2 && DEBUG("not using SNI because openssl is too old");
	}

	$arg_hash->{PeerAddr} || $arg_hash->{PeerHost} || $self->_update_peer;
	if ( $ctx->{verify_name_ref} ) {
	    # need target name for update
	    my $host = $arg_hash->{SSL_verifycn_name}
		|| $arg_hash->{SSL_hostname};
	    if ( ! defined $host ) {
		if ( $host = $arg_hash->{PeerAddr} || $arg_hash->{PeerHost} ) {
		    $host =~s{:[a-zA-Z0-9_\-]+$}{};
		}
	    }
	    ${$ctx->{verify_name_ref}} = $host;
	}

	my $ocsp = $ctx->{ocsp_mode};
	if ( $ocsp & SSL_OCSP_NO_STAPLE ) {
	    # don't try stapling
	} elsif ( ! $can_ocsp_staple ) {
	    croak("OCSP stapling not support") if $ocsp & SSL_OCSP_MUST_STAPLE;
	} elsif ( $ocsp & (SSL_OCSP_TRY_STAPLE|SSL_OCSP_MUST_STAPLE)) {
	    # staple by default if verification enabled
	    ${*$self}{_SSL_ocsp_verify} = undef;
	    Net::SSLeay::set_tlsext_status_type($ssl,
		Net::SSLeay::TLSEXT_STATUSTYPE_ocsp());
	    $DEBUG>=2 && DEBUG("request OCSP stapling");
	}

	if ($ctx->{session_cache} and my $session =
	    $ctx->{session_cache}->get_session($arg_hash->{SSL_session_key})
	) {
	    Net::SSLeay::set_session($ssl, $session);
	}
    }

    $ssl ||= ${*$self}{'_SSL_object'};

    $SSL_ERROR = $! = undef;
    my $timeout = exists $args->{Timeout}
	? $args->{Timeout}
	: ${*$self}{io_socket_timeout}; # from IO::Socket
    if ( defined($timeout) && $timeout>0 && $self->blocking(0) ) {
	$DEBUG>=2 && DEBUG( "set socket to non-blocking to enforce timeout=$timeout" );
	# timeout was given and socket was blocking
	# enforce timeout with now non-blocking socket
    } else {
	# timeout does not apply because invalid or socket non-blocking
	$timeout = undef;
	$auto_retry && $auto_retry->($ssl,$self->blocking);
    }

    my $start = defined($timeout) && time();
    {
	$SSL_ERROR = undef;
	$CURRENT_SSL_OBJECT = $self;
	$DEBUG>=3 && DEBUG("call Net::SSLeay::connect" );
	my $rv = Net::SSLeay::connect($ssl);
	$CURRENT_SSL_OBJECT = undef;
	$DEBUG>=3 && DEBUG("done Net::SSLeay::connect -> $rv" );
	if ( $rv < 0 ) {
	    if ( my $err = $self->_skip_rw_error( $ssl,$rv )) {
		$self->error("SSL connect attempt failed");
		delete ${*$self}{'_SSL_opening'};
		${*$self}{'_SSL_opened'} = -1;
		$DEBUG>=1 && DEBUG( "fatal SSL error: $SSL_ERROR" );
		return $self->fatal_ssl_error();
	    }

	    $DEBUG>=2 && DEBUG('ssl handshake in progress' );
	    # connect failed because handshake needs to be completed
	    # if socket was non-blocking or no timeout was given return with this error
	    return if ! defined($timeout);

	    # wait until socket is readable or writable
	    my $rv;
	    if ( $timeout>0 ) {
		my $vec = '';
		vec($vec,$self->fileno,1) = 1;
		$DEBUG>=2 && DEBUG( "waiting for fd to become ready: $SSL_ERROR" );
		$rv =
		    $SSL_ERROR == SSL_WANT_READ ? select( $vec,undef,undef,$timeout) :
		    $SSL_ERROR == SSL_WANT_WRITE ? select( undef,$vec,undef,$timeout) :
		    undef;
	    } else {
		$DEBUG>=2 && DEBUG("handshake failed because no more time" );
		$! = ETIMEDOUT
	    }
	    if ( ! $rv ) {
		$DEBUG>=2 && DEBUG("handshake failed because socket did not became ready" );
		# failed because of timeout, return
		$! ||= ETIMEDOUT;
		delete ${*$self}{'_SSL_opening'};
		${*$self}{'_SSL_opened'} = -1;
		$self->blocking(1); # was blocking before
		return
	    }

	    # socket is ready, try non-blocking connect again after recomputing timeout
	    $DEBUG>=2 && DEBUG("socket ready, retrying connect" );
	    my $now = time();
	    $timeout -= $now - $start;
	    $start = $now;
	    redo;

	} elsif ( $rv == 0 ) {
	    delete ${*$self}{'_SSL_opening'};
	    $DEBUG>=2 && DEBUG("connection failed - connect returned 0" );
	    $self->error("SSL connect attempt failed because of handshake problems" );
	    ${*$self}{'_SSL_opened'} = -1;
	    return $self->fatal_ssl_error();
	}
    }

    $DEBUG>=2 && DEBUG('ssl handshake done' );
    # ssl connect successful
    delete ${*$self}{'_SSL_opening'};
    ${*$self}{'_SSL_opened'}=1;
    if (defined($timeout)) {
	$self->blocking(1); # reset back to blocking
	$! = undef; # reset errors from non-blocking
    }

    $ctx ||= ${*$self}{'_SSL_ctx'};

    if ( my $ocsp_result = ${*$self}{_SSL_ocsp_verify} ) {
	# got result from OCSP stapling
	if ( $ocsp_result->[0] > 0 ) {
	    $DEBUG>=3 && DEBUG("got OCSP success with stapling");
	    # successful validated
	} elsif ( $ocsp_result->[0] < 0 ) {
	    # Permanent problem with validation because certificate
	    # is either self-signed or the issuer cannot be found.
	    # Ignore here, because this will cause other errors too.
	    $DEBUG>=3 && DEBUG("got OCSP failure with stapling: %s",
		$ocsp_result->[1]);
	} else {
	    # definitely revoked
	    $DEBUG>=3 && DEBUG("got OCSP revocation with stapling: %s",
		$ocsp_result->[1]);
	    $self->_internal_error($ocsp_result->[1],5);
	    return $self->fatal_ssl_error();
	}
    } elsif ( $ctx->{ocsp_mode} & SSL_OCSP_MUST_STAPLE ) {
	$self->_internal_error("did not receive the required stapled OCSP response",5);
	return $self->fatal_ssl_error();
    }

    if (!%sess_cb and $ctx->{session_cache}
	and my $session = Net::SSLeay::get1_session($ssl)) {
	$ctx->{session_cache}->add_session(
	    ${*$self}{_SSL_arguments}{SSL_session_key},
	    $session
	);
    }

    tie *{$self}, "IO::Socket::SSL::SSL_HANDLE", $self;

    return $self;
}

# called if PeerAddr is not set in ${*$self}{'_SSL_arguments'}
# this can be the case if start_SSL is called with a normal IO::Socket::INET
# so that PeerAddr|PeerPort are not set from args
# returns PeerAddr
sub _update_peer {
    my $self = shift;
    my $arg_hash = ${*$self}{'_SSL_arguments'};
    eval {
	my $sockaddr = getpeername( $self );
	my $af = sockaddr_family($sockaddr);
	if( CAN_IPV6 && $af == AF_INET6 ) {
	    my (undef, $host, $port) = _getnameinfo($sockaddr,
		NI_NUMERICHOST | NI_NUMERICSERV);
	    $arg_hash->{PeerPort} = $port;
	    $arg_hash->{PeerAddr} = $host;
	} else {
	    my ($port,$addr) = sockaddr_in( $sockaddr);
	    $arg_hash->{PeerPort} = $port;
	    $arg_hash->{PeerAddr} = inet_ntoa( $addr );
	}
    }
}

#Call to accept occurs when a new client connects to a server using
#IO::Socket::SSL
sub accept {
    my $self = shift || return _invalid_object();
    my $class = shift || 'IO::Socket::SSL';

    my $socket = ${*$self}{'_SSL_opening'};
    if ( ! $socket ) {
	# underlying socket not done
	$DEBUG>=2 && DEBUG('no socket yet' );
	$socket = $self->SUPER::accept($class) || return;
	$DEBUG>=2 && DEBUG('accept created normal socket '.$socket );

	# don't continue with accept_SSL if SSL_startHandshake is set to 0
	my $sh = ${*$self}{_SSL_arguments}{SSL_startHandshake};
	if (defined $sh && ! $sh) {
	    ${*$socket}{_SSL_ctx} = ${*$self}{_SSL_ctx};
	    ${*$socket}{_SSL_arguments} = {
		%{${*$self}{_SSL_arguments}},
		SSL_server => 0,
	    };
	    $DEBUG>=2 && DEBUG('will not start SSL handshake yet');
	    return wantarray ? ($socket, getpeername($socket) ) : $socket
	}
    }

    $self->accept_SSL($socket) || return;
    $DEBUG>=2 && DEBUG('accept_SSL ok' );

    return wantarray ? ($socket, getpeername($socket) ) : $socket;
}

sub accept_SSL {
    my $self = shift;
    my $socket = ( @_ && UNIVERSAL::isa( $_[0], 'IO::Handle' )) ? shift : $self;
    my $args = @_>1 ? {@_}: $_[0]||{};

    my $ssl;
    if ( ! ${*$self}{'_SSL_opening'} ) {
	$DEBUG>=2 && DEBUG('starting sslifying' );
	${*$self}{'_SSL_opening'} = $socket;
	if ($socket != $self) {
	    ${*$socket}{_SSL_ctx} = ${*$self}{_SSL_ctx};
	    ${*$socket}{_SSL_arguments} = {
		%{${*$self}{_SSL_arguments}},
		SSL_server => 0
	    };
	}

	my $fileno = ${*$socket}{'_SSL_fileno'} = fileno($socket);
	return $socket->_internal_error("Socket has no fileno",9)
	    if ! defined $fileno;

	$ssl = ${*$socket}{_SSL_object} =
	    Net::SSLeay::new(${*$socket}{_SSL_ctx}{context})
	    || return $socket->error("SSL structure creation failed");
	$CREATED_IN_THIS_THREAD{$ssl} = 1 if $use_threads;
	$SSL_OBJECT{$ssl} = [$socket,1];
	weaken($SSL_OBJECT{$ssl}[0]);

	Net::SSLeay::set_fd($ssl, $fileno)
	    || return $socket->error("SSL filehandle association failed");
    }

    $ssl ||= ${*$socket}{'_SSL_object'};

    $SSL_ERROR = $! = undef;
    #$DEBUG>=2 && DEBUG('calling ssleay::accept' );

    my $timeout = exists $args->{Timeout}
	? $args->{Timeout}
	: ${*$self}{io_socket_timeout}; # from IO::Socket
    if ( defined($timeout) && $timeout>0 && $socket->blocking(0) ) {
	# timeout was given and socket was blocking
	# enforce timeout with now non-blocking socket
    } else {
	# timeout does not apply because invalid or socket non-blocking
	$timeout = undef;
	$auto_retry && $auto_retry->($ssl,$socket->blocking);
    }

    my $start = defined($timeout) && time();
    {
	$SSL_ERROR = undef;
	$CURRENT_SSL_OBJECT = $self;
	my $rv = Net::SSLeay::accept($ssl);
	$CURRENT_SSL_OBJECT = undef;
	$DEBUG>=3 && DEBUG( "Net::SSLeay::accept -> $rv" );
	if ( $rv < 0 ) {
	    if ( my $err = $socket->_skip_rw_error( $ssl,$rv )) {
		$socket->error("SSL accept attempt failed");
		delete ${*$self}{'_SSL_opening'};
		${*$socket}{'_SSL_opened'} = -1;
		return $socket->fatal_ssl_error();
	    }

	    # accept failed because handshake needs to be completed
	    # if socket was non-blocking or no timeout was given return with this error
	    return if ! defined($timeout);

	    # wait until socket is readable or writable
	    my $rv;
	    if ( $timeout>0 ) {
		my $vec = '';
		vec($vec,$socket->fileno,1) = 1;
		$rv =
		    $SSL_ERROR == SSL_WANT_READ  ? select( $vec,undef,undef,$timeout) :
		    $SSL_ERROR == SSL_WANT_WRITE ? select( undef,$vec,undef,$timeout) :
		    undef;
	    } else {
		$! = ETIMEDOUT
	    }
	    if ( ! $rv ) {
		# failed because of timeout, return
		$! ||= ETIMEDOUT;
		delete ${*$self}{'_SSL_opening'};
		${*$socket}{'_SSL_opened'} = -1;
		$socket->blocking(1); # was blocking before
		return
	    }

	    # socket is ready, try non-blocking accept again after recomputing timeout
	    my $now = time();
	    $timeout -= $now - $start;
	    $start = $now;
	    redo;

	} elsif ( $rv == 0 ) {
	    $socket->error("SSL accept attempt failed because of handshake problems" );
	    delete ${*$self}{'_SSL_opening'};
	    ${*$socket}{'_SSL_opened'} = -1;
	    return $socket->fatal_ssl_error();
	}
    }

    $DEBUG>=2 && DEBUG('handshake done, socket ready' );
    # socket opened
    delete ${*$self}{'_SSL_opening'};
    ${*$socket}{'_SSL_opened'} = 1;
    if (defined($timeout)) {
	$socket->blocking(1); # reset back to blocking
	$! = undef; # reset errors from non-blocking
    }

    tie *{$socket}, "IO::Socket::SSL::SSL_HANDLE", $socket;

    return $socket;
}


####### I/O subroutines ########################

if ($auto_retry) {
    *blocking = sub {
	my $self = shift;
	{ @_ && $auto_retry->(${*$self}{_SSL_object} || last, @_); }
	return $self->SUPER::blocking(@_);
    };
}

sub _generic_read {
    my ($self, $read_func, undef, $length, $offset) = @_;
    my $ssl =  ${*$self}{_SSL_object} || return;
    my $buffer=\$_[2];

    $SSL_ERROR = $! = undef;
    my ($data,$rwerr) = $read_func->($ssl, $length);
    while ( ! defined($data)) {
	if ( my $err = $self->_skip_rw_error( $ssl, defined($rwerr) ? $rwerr:-1 )) {
	    # OpenSSL 1.1.0c+ : EOF can now result in SSL_read returning -1 and SSL_ERROR_SYSCALL
	    # OpenSSL 3.0 : EOF can now result in SSL_read returning -1 and SSL_ERROR_SSL
	    if (not $! and $err == $Net_SSLeay_ERROR_SSL || $err == $Net_SSLeay_ERROR_SYSCALL) {
		# treat as EOF
		$data = '';
		last;
	    }
	    $self->error("SSL read error");
	}
	return;
    }

    $length = length($data);
    $$buffer = '' if !defined $$buffer;
    $offset ||= 0;
    if ($offset>length($$buffer)) {
	$$buffer.="\0" x ($offset-length($$buffer));  #mimic behavior of read
    }

    substr($$buffer, $offset, length($$buffer), $data);
    return $length;
}

sub read {
    my $self = shift;
    ${*$self}{_SSL_object} && return _generic_read($self,
	$self->blocking ? \&Net::SSLeay::ssl_read_all : \&Net::SSLeay::read,
	@_
    );

    # fall back to plain read if we are not required to use SSL yet
    return $self->SUPER::read(@_);
}

# contrary to the behavior of read sysread can read partial data
sub sysread {
    my $self = shift;
    ${*$self}{_SSL_object} && return _generic_read( $self,
	\&Net::SSLeay::read, @_ );

    # fall back to plain sysread if we are not required to use SSL yet
    my $rv = $self->SUPER::sysread(@_);
    return $rv;
}

sub peek {
    my $self = shift;
    ${*$self}{_SSL_object} && return _generic_read( $self,
	\&Net::SSLeay::peek, @_ );

    # fall back to plain peek if we are not required to use SSL yet
    # emulate peek with recv(...,MS_PEEK) - peek(buf,len,offset)
    return if ! defined recv($self,my $buf,$_[1],MSG_PEEK);
    $_[0] = $_[2] ? substr($_[0],0,$_[2]).$buf : $buf;
    return length($buf);
}


sub _generic_write {
    my ($self, $write_all, undef, $length, $offset) = @_;

    my $ssl =  ${*$self}{_SSL_object} || return;
    my $buffer = \$_[2];

    my $buf_len = length($$buffer);
    $length ||= $buf_len;
    $offset ||= 0;
    return $self->_internal_error("Invalid offset for SSL write",9)
	if $offset>$buf_len;
    return 0 if ($offset == $buf_len);

    $SSL_ERROR = $! = undef;
    my $written;
    if ( $write_all ) {
	my $data = $length < $buf_len-$offset ? substr($$buffer, $offset, $length) : $$buffer;
	($written, my $errs) = Net::SSLeay::ssl_write_all($ssl, $data);
	# ssl_write_all returns number of bytes written
	$written = undef if ! $written && $errs;
    } else {
	$written = Net::SSLeay::write_partial( $ssl,$offset,$length,$$buffer );
	# write_partial does SSL_write which returns -1 on error
	$written = undef if $written < 0;
    }
    if ( !defined($written) ) {
	if ( my $err = $self->_skip_rw_error( $ssl,-1 )) {
	    # if $! is not set with ERROR_SYSCALL then report as EPIPE
	    $! ||= EPIPE if $err == $Net_SSLeay_ERROR_SYSCALL;
	    $self->error("SSL write error ($err)");
	}
	return;
    }

    return $written;
}

# if socket is blocking write() should return only on error or
# if all data are written
sub write {
    my $self = shift;
    ${*$self}{_SSL_object} && return _generic_write( $self,
	scalar($self->blocking),@_ );

    # fall back to plain write if we are not required to use SSL yet
    return $self->SUPER::write(@_);
}

# contrary to write syswrite() returns already if only
# a part of the data is written
sub syswrite {
    my $self = shift;
    ${*$self}{_SSL_object} && return _generic_write($self,0,@_);

    # fall back to plain syswrite if we are not required to use SSL yet
    return $self->SUPER::syswrite(@_);
}

sub print {
    my $self = shift;
    my $string = join(($, or ''), @_, ($\ or ''));
    return $self->write( $string );
}

sub printf {
    my ($self,$format) = (shift,shift);
    return $self->write(sprintf($format, @_));
}

sub getc {
    my ($self, $buffer) = (shift, undef);
    return $buffer if $self->read($buffer, 1, 0);
}

sub readline {
    my $self = shift;
    ${*$self}{_SSL_object} or return $self->SUPER::getline;

    if ( not defined $/ or wantarray) {
	# read all and split

	my $buf = '';
	while (1) {
	    my $rv = $self->sysread($buf,2**16,length($buf));
	    if ( ! defined $rv ) {
		next if $! == EINTR;       # retry
		last if $! == EWOULDBLOCK || $! == EAGAIN; # use everything so far
		return;                    # return error
	    } elsif ( ! $rv ) {
		last
	    }
	}

	if ( ! defined $/ ) {
	    return $buf
	} elsif ( ref($/)) {
	    my $size = ${$/};
	    die "bad value in ref \$/: $size" unless $size>0;
	    return $buf=~m{\G(.{1,$size})}g;
	} elsif ( $/ eq '' ) {
	    return $buf =~m{\G(.*\n\n+|.+)}g;
	} else {
	    return $buf =~m{\G(.*$/|.+)}g;
	}
    }

    # read only one line
    if ( ref($/) ) {
	my $size = ${$/};
	# read record of $size bytes
	die "bad value in ref \$/: $size" unless $size>0;
	my $buf = '';
	while ( $size>length($buf)) {
	    my $rv = $self->sysread($buf,$size-length($buf),length($buf));
	    if ( ! defined $rv ) {
		next if $! == EINTR;       # retry
		last if $! == EWOULDBLOCK || $! == EAGAIN; # use everything so far
		return;                    # return error
	    } elsif ( ! $rv ) {
		last
	    }
	}
	return $buf;
    }

    my ($delim0,$delim1) = $/ eq '' ? ("\n\n","\n"):($/,'');

    # find first occurrence of $delim0 followed by as much as possible $delim1
    my $buf = '';
    my $eod = 0;  # pointer into $buf after $delim0 $delim1*
    my $ssl = $self->_get_ssl_object or return;
    while (1) {

	# wait until we have more data or eof
	my $poke = Net::SSLeay::peek($ssl,1);
	if ( ! defined $poke or $poke eq '' ) {
	    next if $! == EINTR;
	}

	my $skip = 0;

	# peek into available data w/o reading
	my $pending = Net::SSLeay::pending($ssl);
	if ( $pending and
	    ( my $pb = Net::SSLeay::peek( $ssl,$pending )) ne '' ) {
	    $buf .= $pb
	} else {
	    return $buf eq '' ? ():$buf;
	}
	if ( !$eod ) {
	    my $pos = index( $buf,$delim0 );
	    if ( $pos<0 ) {
		$skip = $pending
	    } else {
		$eod = $pos + length($delim0); # pos after delim0
	    }
	}

	if ( $eod ) {
	    if ( $delim1 ne '' ) {
		# delim0 found, check for as much delim1 as possible
		while ( index( $buf,$delim1,$eod ) == $eod ) {
		    $eod+= length($delim1);
		}
	    }
	    $skip = $pending - ( length($buf) - $eod );
	}

	# remove data from $self which I already have in buf
	while ( $skip>0 ) {
	    if ($self->sysread(my $p,$skip,0)) {
		$skip -= length($p);
		next;
	    }
	    $! == EINTR or last;
	}

	if ( $eod and ( $delim1 eq '' or $eod < length($buf))) {
	    # delim0 found and there can be no more delim1 pending
	    last
	}
    }
    return substr($buf,0,$eod);
}

sub close {
    my $self = shift || return _invalid_object();
    my $close_args = (ref($_[0]) eq 'HASH') ? $_[0] : {@_};

    return if ! $self->stop_SSL(
	SSL_fast_shutdown => 1,
	%$close_args,
	_SSL_ioclass_downgrade => 0,
    );

    if ( ! $close_args->{_SSL_in_DESTROY} ) {
	untie( *$self );
	undef ${*$self}{_SSL_fileno};
	return $self->SUPER::close;
    }
    return 1;
}

sub is_SSL {
    my $self = pop;
    return ${*$self}{_SSL_object} && 1
}

sub stop_SSL {
    my $self = shift || return _invalid_object();
    my $stop_args = (ref($_[0]) eq 'HASH') ? $_[0] : {@_};
    $stop_args->{SSL_no_shutdown} = 1 if ! ${*$self}{_SSL_opened};

    if (my $ssl = ${*$self}{'_SSL_object'}) {
	if (delete ${*$self}{'_SSL_opening'}) {
	    # just destroy the object further below
	} elsif ( ! $stop_args->{SSL_no_shutdown} ) {
	    my $status = Net::SSLeay::get_shutdown($ssl);

	    my $timeout =
		not($self->blocking) ? undef :
		exists $stop_args->{Timeout} ? $stop_args->{Timeout} :
		${*$self}{io_socket_timeout}; # from IO::Socket
	    if ($timeout) {
		$self->blocking(0);
		$timeout += time();
	    }

	    while (1) {
		if ( $status & SSL_SENT_SHUTDOWN and
		    # don't care for received if fast shutdown
		    $status & SSL_RECEIVED_SHUTDOWN
			|| $stop_args->{SSL_fast_shutdown}) {
		    # shutdown complete
		    last;
		}
		if ((${*$self}{'_SSL_opened'}||0) <= 0) {
		    # not really open, thus don't expect shutdown to return
		    # something meaningful
		    last;
		}

		# initiate or complete shutdown
		local $SIG{PIPE} = 'IGNORE';
		my $rv = Net::SSLeay::shutdown($ssl);
		if ( $rv < 0 ) {
		    # non-blocking socket?
		    if ( ! $timeout ) {
			$self->_skip_rw_error( $ssl,$rv );
			# need to try again
			return;
		    }

		    # don't use _skip_rw_error so that existing error does
		    # not get cleared
		    my $wait = $timeout - time();
		    last if $wait<=0;
		    vec(my $vec = '',fileno($self),1) = 1;
		    my $err = Net::SSLeay::get_error($ssl,$rv);
		    if ( $err == $Net_SSLeay_ERROR_WANT_READ) {
			select($vec,undef,undef,$wait)
		    } elsif ( $err == $Net_SSLeay_ERROR_WANT_READ) {
			select(undef,$vec,undef,$wait)
		    } else {
			last;
		    }
		}

		$status |= SSL_SENT_SHUTDOWN;
		$status |= SSL_RECEIVED_SHUTDOWN if $rv>0;
	    }
	    $self->blocking(1) if $timeout;
	}

	# destroy allocated objects for SSL and untie
	# do not destroy CTX unless explicitly specified
	Net::SSLeay::free($ssl);
	if (my $cert = delete ${*$self}{'_SSL_certificate'}) {
	    Net::SSLeay::X509_free($cert);
	}
	delete ${*$self}{_SSL_object};
	${*$self}{'_SSL_opened'} = 0;
	delete $SSL_OBJECT{$ssl};
	delete $CREATED_IN_THIS_THREAD{$ssl};
	untie(*$self);
    }

    if ($stop_args->{'SSL_ctx_free'}) {
	my $ctx = delete ${*$self}{'_SSL_ctx'};
	$ctx && $ctx->DESTROY();
    }


    if ( ! $stop_args->{_SSL_in_DESTROY} ) {

	my $downgrade = $stop_args->{_SSL_ioclass_downgrade};
	if ( $downgrade || ! defined $downgrade ) {
	    # rebless to original class from start_SSL
	    if ( my $orig_class = delete ${*$self}{'_SSL_ioclass_upgraded'} ) {
		bless $self,$orig_class;
		# FIXME: if original class was tied too we need to restore the tie
		# remove all _SSL related from *$self
		my @sslkeys = grep { m{^_?SSL_} } keys %{*$self};
		delete @{*$self}{@sslkeys} if @sslkeys;
	    }
	}
    }
    return 1;
}


sub fileno {
    my $self = shift;
    my $fn = ${*$self}{'_SSL_fileno'};
	return defined($fn) ? $fn : $self->SUPER::fileno();
}


####### IO::Socket::SSL specific functions #######
# _get_ssl_object is for internal use ONLY!
sub _get_ssl_object {
    my $self = shift;
    return ${*$self}{'_SSL_object'} ||
	IO::Socket::SSL->_internal_error("Undefined SSL object",9);
}

# _get_ctx_object is for internal use ONLY!
sub _get_ctx_object {
    my $self = shift;
    my $ctx_object = ${*$self}{_SSL_ctx};
    return $ctx_object && $ctx_object->{context};
}

# default error for undefined arguments
sub _invalid_object {
    return IO::Socket::SSL->_internal_error("Undefined IO::Socket::SSL object",9);
}


sub pending {
    my $ssl = shift()->_get_ssl_object || return;
    return Net::SSLeay::pending($ssl);
}

sub start_SSL {
    my ($class,$socket) = (shift,shift);
    return $class->_internal_error("Not a socket",9) if ! ref($socket);
    my $arg_hash = @_ == 1 ? $_[0] : {@_};
    my %to = exists $arg_hash->{Timeout} ? ( Timeout => delete $arg_hash->{Timeout} ) :();
    my $original_class = ref($socket);
    if ( ! $original_class ) {
	$socket = ($original_class = $ISA[0])->new_from_fd($socket,'<+')
	    or return $class->_internal_error(
	    "creating $original_class from file handle failed",9);
    }
    my $original_fileno = (UNIVERSAL::can($socket, "fileno"))
	? $socket->fileno : CORE::fileno($socket);
    return $class->_internal_error("Socket has no fileno",9)
	if ! defined $original_fileno;

    bless $socket, $class;
    $socket->configure_SSL($arg_hash) or bless($socket, $original_class) && return;

    ${*$socket}{'_SSL_fileno'} = $original_fileno;
    ${*$socket}{'_SSL_ioclass_upgraded'} = $original_class
	if $class ne $original_class;

    my $start_handshake = $arg_hash->{SSL_startHandshake};
    if ( ! defined($start_handshake) || $start_handshake ) {
	# if we have no callback force blocking mode
	$DEBUG>=2 && DEBUG( "start handshake" );
	my $was_blocking = $socket->blocking(1);
	my $result = ${*$socket}{'_SSL_arguments'}{SSL_server}
	    ? $socket->accept_SSL(%to)
	    : $socket->connect_SSL(%to);
	if ( $result ) {
	    $socket->blocking(0) if ! $was_blocking;
	    return $socket;
	} else {
	    # upgrade to SSL failed, downgrade socket to original class
	    if ( $original_class ) {
		bless($socket,$original_class);
		$socket->blocking(0) if ! $was_blocking
		    && $socket->can('blocking');
	    }
	    return;
	}
    } else {
	$DEBUG>=2 && DEBUG( "don't start handshake: $socket" );
	return $socket; # just return upgraded socket
    }

}

sub new_from_fd {
    my ($class, $fd) = (shift,shift);
    # Check for accidental inclusion of MODE in the argument list
    if (length($_[0]) < 4) {
	(my $mode = $_[0]) =~ tr/+<>//d;
	shift unless length($mode);
    }
    my $handle = $ISA[0]->new_from_fd($fd, '+<')
	|| return($class->error("Could not create socket from file descriptor."));

    # Annoying workaround for Perl 5.6.1 and below:
    $handle = $ISA[0]->new_from_fd($handle, '+<');

    return $class->start_SSL($handle, @_);
}


sub dump_peer_certificate {
    my $ssl = shift()->_get_ssl_object || return;
    return Net::SSLeay::dump_peer_certificate($ssl);
}

if ( defined &Net::SSLeay::get_peer_cert_chain
    && $netssleay_version >= 1.58 ) {
    *peer_certificates = sub {
	my $self = shift;
	my $ssl = $self->_get_ssl_object || return;
	my @chain = Net::SSLeay::get_peer_cert_chain($ssl);
	@chain = () if @chain && !$self->peer_certificate; # work around #96013
	if ( ${*$self}{_SSL_arguments}{SSL_server} ) {
	    # in the client case the chain contains the peer certificate,
	    # in the server case not
	    # this one has an increased reference counter, the other not
	    if ( my $peer = Net::SSLeay::get_peer_certificate($ssl)) {
		Net::SSLeay::X509_free($peer);
		unshift @chain, $peer;
	    }
	}
	return @chain;

    }
} else {
    *peer_certificates = sub {
	die "peer_certificates needs Net::SSLeay>=1.58";
    }
}

{
    my %dispatcher = (
	issuer =>  sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_issuer_name( shift )) },
	subject => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name( shift )) },
	commonName => sub {
	    my $cn = Net::SSLeay::X509_NAME_get_text_by_NID(
		Net::SSLeay::X509_get_subject_name( shift ), NID_CommonName);
	    $cn;
	},
	subjectAltNames => sub { Net::SSLeay::X509_get_subjectAltNames( shift ) },
    );

    # alternative names
    $dispatcher{authority} = $dispatcher{issuer};
    $dispatcher{owner}     = $dispatcher{subject};
    $dispatcher{cn}        = $dispatcher{commonName};

    sub peer_certificate {
	my ($self,$field,$reload) = @_;
	my $ssl = $self->_get_ssl_object or return;

	Net::SSLeay::X509_free(delete ${*$self}{_SSL_certificate})
	    if $reload && ${*$self}{_SSL_certificate};
	my $cert = ${*$self}{_SSL_certificate}
	    ||= Net::SSLeay::get_peer_certificate($ssl)
	    or return $self->error("Could not retrieve peer certificate");

	if ($field) {
	    my $sub = $dispatcher{$field} or croak
		"invalid argument for peer_certificate, valid are: ".join( " ",keys %dispatcher ).
		"\nMaybe you need to upgrade your Net::SSLeay";
	    return $sub->($cert);
	} else {
	    return $cert
	}
    }

    sub sock_certificate {
	my ($self,$field) = @_;
	my $ssl = $self->_get_ssl_object || return;
	my $cert = Net::SSLeay::get_certificate( $ssl ) || return;
	if ($field) {
	    my $sub = $dispatcher{$field} or croak
		"invalid argument for sock_certificate, valid are: ".join( " ",keys %dispatcher ).
		"\nMaybe you need to upgrade your Net::SSLeay";
	    return $sub->($cert);
	} else {
	    return $cert
	}
    }


    # known schemes, possible attributes are:
    #  - wildcards_in_alt (0, 'full_label', 'anywhere')
    #  - wildcards_in_cn (0, 'full_label', 'anywhere')
    #  - check_cn (0, 'always', 'when_only')
    # unfortunately there are a lot of different schemes used, see RFC 6125 for a
    # summary, which references all of the following except RFC4217/ftp

    my %scheme = (
	none => {}, # do not check
	# default set is a superset of all the others and thus worse than a more
	# specific set, but much better than not verifying name at all
	default => {
	    wildcards_in_cn  => 'anywhere',
	    wildcards_in_alt => 'anywhere',
	    check_cn         => 'always',
	    ip_in_cn         => 1,
	},
    );

    for(qw(
	rfc2818
	rfc3920 xmpp
	rfc4217 ftp
    )) {
	$scheme{$_} = {
	    wildcards_in_cn  => 'anywhere',
	    wildcards_in_alt => 'anywhere',
	    check_cn         => 'when_only',
	}
    }

    for(qw(www http)) {
	$scheme{$_} = {
	    wildcards_in_cn  => 'anywhere',
	    wildcards_in_alt => 'anywhere',
	    check_cn         => 'when_only',
	    ip_in_cn         => 4,
	}
    }

    for(qw(
	rfc4513 ldap
    )) {
	$scheme{$_} = {
	    wildcards_in_cn  => 0,
	    wildcards_in_alt => 'full_label',
	    check_cn         => 'always',
	};
    }

    for(qw(
	rfc2595 smtp
	rfc4642 imap pop3 acap
	rfc5539 nntp
	rfc5538 netconf
	rfc5425 syslog
	rfc5953 snmp
    )) {
	$scheme{$_} = {
	    wildcards_in_cn  => 'full_label',
	    wildcards_in_alt => 'full_label',
	    check_cn         => 'always'
	};
    }
    for(qw(
	rfc5971 gist
    )) {
	$scheme{$_} = {
	    wildcards_in_cn  => 'full_label',
	    wildcards_in_alt => 'full_label',
	    check_cn         => 'when_only',
	};
    }

    for(qw(
	rfc5922 sip
    )) {
	$scheme{$_} = {
	    wildcards_in_cn  => 0,
	    wildcards_in_alt => 0,
	    check_cn         => 'always',
	};
    }


    # function to verify the hostname
    #
    # as every application protocol has its own rules to do this
    # we provide some default rules as well as a user-defined
    # callback

    sub verify_hostname_of_cert {
	my $identity = shift;
	my $cert = shift;
	my $scheme = shift || 'default';
	my $publicsuffix = shift;
	if ( ! ref($scheme) ) {
	    $DEBUG>=3 && DEBUG( "scheme=$scheme cert=$cert" );
	    $scheme = $scheme{$scheme} || croak("scheme $scheme not defined");
	}

	return 1 if ! %$scheme; # 'none'
	$identity =~s{\.+$}{}; # ignore absolutism

	# get data from certificate
	my $commonName = $dispatcher{cn}->($cert);
	my @altNames = $dispatcher{subjectAltNames}->($cert);
	$DEBUG>=3 && DEBUG("identity=$identity cn=$commonName alt=@altNames" );

	if ( my $sub = $scheme->{callback} ) {
	    # use custom callback
	    return $sub->($identity,$commonName,@altNames);
	}

	# is the given hostname an IP address? Then we have to convert to network byte order [RFC791][RFC2460]

	my $ipn;
	if ( CAN_IPV6 and $identity =~m{:} ) {
	    # no IPv4 or hostname have ':'  in it, try IPv6.
	    $identity =~m{[^\da-fA-F:\.]} and return; # invalid characters in name
	    $ipn = inet_pton(AF_INET6,$identity) or return; # invalid name
	} elsif ( my @ip = $identity =~m{^(\d+)(?:\.(\d+)\.(\d+)\.(\d+)|[\d\.]*)$} ) {
	    # check for invalid IP/hostname
	    return if 4 != @ip or 4 != grep { defined($_) && $_<256 } @ip;
	    $ipn = pack("CCCC",@ip);
	} else {
	    # assume hostname, check for umlauts etc
	    if ( $identity =~m{[^a-zA-Z0-9_.\-]} ) {
		$identity =~m{\0} and return; # $identity has \\0 byte
		$identity = idn_to_ascii($identity)
		    or return; # conversation to IDNA failed
		$identity =~m{[^a-zA-Z0-9_.\-]}
		    and return; # still junk inside
	    }
	}

	# do the actual verification
	my $check_name = sub {
	    my ($name,$identity,$wtyp,$publicsuffix) = @_;
	    $name =~s{\.+$}{}; # ignore absolutism
	    $name eq '' and return;
	    $wtyp ||= '';
	    my $pattern;
	    ### IMPORTANT!
	    # We accept only a single wildcard and only for a single part of the FQDN
	    # e.g. *.example.org does match www.example.org but not bla.www.example.org
	    # The RFCs are in this regard unspecific but we don't want to have to
	    # deal with certificates like *.com, *.co.uk or even *
	    # see also http://nils.toedtmann.net/pub/subjectAltName.txt .
	    # Also, we fall back to full_label matches if the identity is an IDNA
	    # name, see RFC6125 and the discussion at
	    # http://bugs.python.org/issue17997#msg194950
	    if ( $wtyp eq 'anywhere' and $name =~m{^([a-zA-Z0-9_\-]*)\*(.+)} ) {
		return if $1 ne '' and substr($identity,0,4) eq 'xn--'; # IDNA
		$pattern = qr{^\Q$1\E[a-zA-Z0-9_\-]+\Q$2\E$}i;
	    } elsif ( $wtyp =~ m{^(?:full_label|leftmost)$}
		and $name =~m{^\*(\..+)$} ) {
		$pattern = qr{^[a-zA-Z0-9_\-]+\Q$1\E$}i;
	    } else {
		return lc($identity) eq lc($name);
	    }
	    if ( $identity =~ $pattern ) {
		$publicsuffix = IO::Socket::SSL::PublicSuffix->default
		    if ! defined $publicsuffix;
		return 1 if $publicsuffix eq '';
		my @labels = split( m{\.+}, $identity );
		my $tld = $publicsuffix->public_suffix(\@labels,+1);
		return 1 if @labels > ( $tld ? 0+@$tld : 1 );
	    }
	    return;
	};


	my $alt_dnsNames = 0;
	while (@altNames) {
	    my ($type, $name) = splice (@altNames, 0, 2);
	    if ( $ipn and $type == GEN_IPADD ) {
		# exact match needed for IP
		# $name is already packed format (inet_xton)
		return 1 if $ipn eq $name;

	    } elsif ( ! $ipn and $type == GEN_DNS ) {
		$name =~s/\s+$//; $name =~s/^\s+//;
		$alt_dnsNames++;
		$check_name->($name,$identity,$scheme->{wildcards_in_alt},$publicsuffix)
		    and return 1;
	    }
	}

	if ( $scheme->{check_cn} eq 'always' or
	    $scheme->{check_cn} eq 'when_only' and !$alt_dnsNames ) {
	    if ( ! $ipn ) {
		$check_name->($commonName,$identity,$scheme->{wildcards_in_cn},$publicsuffix)
		    and return 1;
	    } elsif ( $scheme->{ip_in_cn} ) {
		if ( $identity eq $commonName ) {
		    return 1 if
			$scheme->{ip_in_cn} == 4 ? length($ipn) == 4 :
			$scheme->{ip_in_cn} == 6 ? length($ipn) == 16 :
			1;
		}
	    }
	}

	return 0; # no match
    }
}

sub verify_hostname {
    my $self = shift;
    my $host = shift;
    my $cert = $self->peer_certificate;
    return verify_hostname_of_cert( $host,$cert,@_ );
}


sub get_servername {
    my $self = shift;
    return ${*$self}{_SSL_servername} ||= do {
	my $ssl = $self->_get_ssl_object or return;
	Net::SSLeay::get_servername($ssl);
    };
}

sub get_fingerprint_bin {
    my ($self,$algo,$cert,$key_only) = @_;
    $cert ||= $self->peer_certificate;
    return $key_only
	? Net::SSLeay::X509_pubkey_digest($cert, $algo2digest->($algo || 'sha256'))
	: Net::SSLeay::X509_digest($cert, $algo2digest->($algo || 'sha256'));
}

sub get_fingerprint {
    my ($self,$algo,$cert,$key_only) = @_;
    $algo ||= 'sha256';
    my $fp = get_fingerprint_bin($self,$algo,$cert,$key_only) or return;
    return $algo.'$'.($key_only ? 'pub$':'').unpack('H*',$fp);
}

sub get_cipher {
    my $ssl = shift()->_get_ssl_object || return;
    return Net::SSLeay::get_cipher($ssl);
}

sub get_sslversion {
    my $ssl = shift()->_get_ssl_object || return;
    my $version = Net::SSLeay::version($ssl) or return;
    return
	$version == 0x0304 ? 'TLSv1_3' :
	$version == 0x0303 ? 'TLSv1_2' :
	$version == 0x0302 ? 'TLSv1_1' :
	$version == 0x0301 ? 'TLSv1'   :
	$version == 0x0300 ? 'SSLv3'   :
	$version == 0x0002 ? 'SSLv2'   :
	$version == 0xfeff ? 'DTLS1'   :
	undef;
}

sub get_sslversion_int {
    my $ssl = shift()->_get_ssl_object || return;
    return Net::SSLeay::version($ssl);
}

sub get_session_reused {
    return Net::SSLeay::session_reused(
	shift()->_get_ssl_object || return);
}

if ($can_ocsp) {
    no warnings 'once';
    *ocsp_resolver = sub {
	my $self = shift;
	my $ssl = $self->_get_ssl_object || return;
	my $ctx = ${*$self}{_SSL_ctx};
	return IO::Socket::SSL::OCSP_Resolver->new(
	    $ssl,
	    $ctx->{ocsp_cache} ||= IO::Socket::SSL::OCSP_Cache->new,
	    $ctx->{ocsp_mode} & SSL_OCSP_FAIL_HARD,
	    @_ ? \@_ :
		$ctx->{ocsp_mode} & SSL_OCSP_FULL_CHAIN ? [ $self->peer_certificates ]:
		[ $self->peer_certificate ]
	);
    };
}

sub errstr {
    my $self = shift;
    my $oe = ref($self) && ${*$self}{_SSL_last_err};
    return $oe ? $oe->[0] : $SSL_ERROR || '';
}

sub fatal_ssl_error {
    my $self = shift;
    my $error_trap = ${*$self}{'_SSL_arguments'}->{'SSL_error_trap'};
    $@ = $self->errstr;
    if (defined $error_trap and ref($error_trap) eq 'CODE') {
	$error_trap->($self, $self->errstr()."\n".$self->get_ssleay_error());
    } elsif ( ${*$self}{'_SSL_ioclass_upgraded'}
	|| ${*$self}{_SSL_arguments}{SSL_keepSocketOnError}) {
	# downgrade only
	$DEBUG>=3 && DEBUG('downgrading SSL only, not closing socket' );
	$self->stop_SSL;
    } else {
	# kill socket
	$self->close
    }
    return;
}

sub get_ssleay_error {
    #Net::SSLeay will print out the errors itself unless we explicitly
    #undefine $Net::SSLeay::trace while running print_errs()
    local $Net::SSLeay::trace;
    return Net::SSLeay::print_errs('SSL error: ') || '';
}

# internal errors, e.g. unsupported features, hostname check failed etc
# _SSL_last_err contains severity so that on error chains we can decide if one
# error should replace the previous one or if this is just a less specific
# follow-up error, e.g. configuration failed because certificate failed because
# hostname check went wrong:
# 0 - fallback errors
# 4 - errors bubbled up from OpenSSL (sub error, r/w error)
# 5 - hostname or OCSP verification failed
# 9 - fatal problems, e.g. missing feature, no fileno...
# _SSL_last_err and SSL_ERROR are only replaced if the error has a higher
# severity than the previous one

sub _internal_error {
    my ($self, $error, $severity) = @_;
    $error = dualvar( -1, $error );
    $self = $CURRENT_SSL_OBJECT if !ref($self) && $CURRENT_SSL_OBJECT;
    if (ref($self)) {
	my $oe = ${*$self}{_SSL_last_err};
	if (!$oe || $oe->[1] <= $severity) {
	    ${*$self}{_SSL_last_err} = [$error,$severity];
	    $SSL_ERROR = $error;
	    $DEBUG && DEBUG("local error: $error");
	} else {
	    $DEBUG && DEBUG("ignoring less severe local error '$error', keep '$oe->[0]'");
	}
    } else {
	$SSL_ERROR = $error;
	$DEBUG && DEBUG("global error: $error");
    }
    return;
}

# OpenSSL errors
sub error {
    my ($self, $error) = @_;
    my @err;
    while ( my $err = Net::SSLeay::ERR_get_error()) {
	push @err, Net::SSLeay::ERR_error_string($err);
	$DEBUG>=2 && DEBUG( $error."\n".$self->get_ssleay_error());
    }
    $error .= ' '.join(' ',@err) if @err;
    return $self->_internal_error($error,4) if $error;
    return;
}

sub _errstack {
    my @err;
    while (my $err = Net::SSLeay::ERR_get_error()) {
	push @err, Net::SSLeay::ERR_error_string($err);
    }
    return @err;
}

sub can_client_sni { return $can_client_sni }
sub can_server_sni { return $can_server_sni }
sub can_multi_cert { return $can_multi_cert }
sub can_npn        { return $can_npn }
sub can_alpn       { return $can_alpn }
sub can_ecdh       { return $can_ecdh }
sub can_ipv6       { return CAN_IPV6 }
sub can_ocsp       { return $can_ocsp }
sub can_ticket_keycb { return $can_tckt_keycb }
sub can_pha        { return $can_pha }
sub can_partial_chain { return $check_partial_chain && 1 }

sub DESTROY {
    my $self = shift or return;
    if (my $ssl = ${*$self}{_SSL_object}) {
	delete $SSL_OBJECT{$ssl};
	if (!$use_threads or delete $CREATED_IN_THIS_THREAD{$ssl}) {
	    $self->close(_SSL_in_DESTROY => 1, SSL_no_shutdown => 1);
	}
    }
    delete @{*$self}{@all_my_keys};
}


#######Extra Backwards Compatibility Functionality#######
sub socket_to_SSL { IO::Socket::SSL->start_SSL(@_); }
sub socketToSSL { IO::Socket::SSL->start_SSL(@_); }
sub kill_socket { shift->close }

sub issuer_name { return(shift()->peer_certificate("issuer")) }
sub subject_name { return(shift()->peer_certificate("subject")) }
sub get_peer_certificate { return shift() }

sub context_init {
    return($GLOBAL_SSL_ARGS = (ref($_[0]) eq 'HASH') ? $_[0] : {@_});
}

sub set_default_context {
    $GLOBAL_SSL_ARGS->{'SSL_reuse_ctx'} = shift;
}

sub set_default_session_cache {
    $GLOBAL_SSL_ARGS->{SSL_session_cache} = shift;
}


{
    my $set_defaults = sub {
	my $args = shift;
	for(my $i=0;$i<@$args;$i+=2 ) {
	    my ($k,$v) = @{$args}[$i,$i+1];
	    if ( $k =~m{^SSL_} ) {
		$_->{$k} = $v for(@_);
	    } elsif ( $k =~m{^(name|scheme)$} ) {
		$_->{"SSL_verifycn_$k"} = $v for (@_);
	    } elsif ( $k =~m{^(callback|mode)$} ) {
		$_->{"SSL_verify_$k"} = $v for(@_);
	    } else {
		$_->{"SSL_$k"} = $v for(@_);
	    }
	}
    };
    sub set_defaults {
	my %args = @_;
	$set_defaults->(\@_,
	    $GLOBAL_SSL_ARGS,
	    $GLOBAL_SSL_CLIENT_ARGS,
	    $GLOBAL_SSL_SERVER_ARGS
	);
    }
    { # deprecated API
	no warnings;
	*set_ctx_defaults = \&set_defaults;
    }
    sub set_client_defaults {
	my %args = @_;
	$set_defaults->(\@_, $GLOBAL_SSL_CLIENT_ARGS );
    }
    sub set_server_defaults {
	my %args = @_;
	$set_defaults->(\@_, $GLOBAL_SSL_SERVER_ARGS );
    }
}

sub set_args_filter_hack {
    my $sub = shift;
    if ( ref $sub ) {
	$FILTER_SSL_ARGS = $sub;
    } elsif ( $sub eq 'use_defaults' ) {
	# override args with defaults
	$FILTER_SSL_ARGS = sub {
	    my ($is_server,$args) = @_;
	    %$args = ( %$args, $is_server
		? ( %DEFAULT_SSL_SERVER_ARGS, %$GLOBAL_SSL_SERVER_ARGS )
		: ( %DEFAULT_SSL_CLIENT_ARGS, %$GLOBAL_SSL_CLIENT_ARGS )
	    );
	}
    }
}

sub next_proto_negotiated {
    my $self = shift;
    return $self->_internal_error("NPN not supported in Net::SSLeay",9) if ! $can_npn;
    my $ssl = $self->_get_ssl_object || return;
    return Net::SSLeay::P_next_proto_negotiated($ssl);
}

sub alpn_selected {
    my $self = shift;
    return $self->_internal_error("ALPN not supported in Net::SSLeay",9) if ! $can_alpn;
    my $ssl = $self->_get_ssl_object || return;
    return Net::SSLeay::P_alpn_selected($ssl);
}

sub opened {
    my $self = shift;
    return IO::Handle::opened($self) && ${*$self}{'_SSL_opened'};
}

sub opening {
    my $self = shift;
    return ${*$self}{'_SSL_opening'};
}

sub want_read  { shift->errstr == SSL_WANT_READ }
sub want_write { shift->errstr == SSL_WANT_WRITE }


#Redundant IO::Handle functionality
sub getline { return(scalar shift->readline()) }
sub getlines {
    return(shift->readline()) if wantarray();
    croak("Use of getlines() not allowed in scalar context");
}

#Useless IO::Handle functionality
sub truncate { croak("Use of truncate() not allowed with SSL") }
sub stat     { croak("Use of stat() not allowed with SSL" ) }
sub setbuf   { croak("Use of setbuf() not allowed with SSL" ) }
sub setvbuf  { croak("Use of setvbuf() not allowed with SSL" ) }
sub fdopen   { croak("Use of fdopen() not allowed with SSL" ) }

#Unsupported socket functionality
sub ungetc { croak("Use of ungetc() not implemented in IO::Socket::SSL") }
sub send   { croak("Use of send() not implemented in IO::Socket::SSL; use print/printf/syswrite instead") }
sub recv   { croak("Use of recv() not implemented in IO::Socket::SSL; use read/sysread instead") }

package IO::Socket::SSL::SSL_HANDLE;
use strict;
use Errno 'EBADF';
*weaken = *IO::Socket::SSL::weaken;

sub TIEHANDLE {
    my ($class, $handle) = @_;
    weaken($handle);
    bless \$handle, $class;
}

sub READ     { ${shift()}->sysread(@_) }
sub READLINE { ${shift()}->readline(@_) }
sub GETC     { ${shift()}->getc(@_) }

sub PRINT    { ${shift()}->print(@_) }
sub PRINTF   { ${shift()}->printf(@_) }
sub WRITE    { ${shift()}->syswrite(@_) }

sub FILENO   { ${shift()}->fileno(@_) }

sub TELL     { $! = EBADF; return -1 }
sub BINMODE  { return 0 }  # not perfect, but better than not implementing the method

sub CLOSE {                          #<---- Do not change this function!
    my $ssl = ${$_[0]};
    local @_;
    $ssl->close();
}


package IO::Socket::SSL::SSL_Context;
use Carp;
use strict;

my %CTX_CREATED_IN_THIS_THREAD;
*DEBUG = *IO::Socket::SSL::DEBUG;
*_errstack = \&IO::Socket::SSL::_errstack;

use constant SSL_MODE_ENABLE_PARTIAL_WRITE => 1;
use constant SSL_MODE_ACCEPT_MOVING_WRITE_BUFFER => 2;

use constant FILETYPE_PEM => Net::SSLeay::FILETYPE_PEM();
use constant FILETYPE_ASN1 => Net::SSLeay::FILETYPE_ASN1();

my $DEFAULT_SSL_OP = &Net::SSLeay::OP_ALL
    | &Net::SSLeay::OP_SINGLE_DH_USE
    | ($can_ecdh ? &Net::SSLeay::OP_SINGLE_ECDH_USE : 0);

# Note that the final object will actually be a reference to the scalar
# (C-style pointer) returned by Net::SSLeay::CTX_*_new() so that
# it can be blessed.
sub new {
    my $class = shift;
    #DEBUG( "$class @_" );
    my $arg_hash = (ref($_[0]) eq 'HASH') ? $_[0] : {@_};

    my $is_server = $arg_hash->{SSL_server};
    my %defaults = $is_server
	? (%DEFAULT_SSL_SERVER_ARGS, %$GLOBAL_SSL_ARGS, %$GLOBAL_SSL_SERVER_ARGS)
	: (%DEFAULT_SSL_CLIENT_ARGS, %$GLOBAL_SSL_ARGS, %$GLOBAL_SSL_CLIENT_ARGS);
    if ( $defaults{SSL_reuse_ctx} ) {
	# ignore default context if there are args to override it
	delete $defaults{SSL_reuse_ctx}
	    if grep { m{^SSL_(?!verifycn_name|hostname)$} } keys %$arg_hash;
    }
    %$arg_hash = ( %defaults, %$arg_hash ) if %defaults;

    if (my $ctx = $arg_hash->{'SSL_reuse_ctx'}) {
	if ($ctx->isa('IO::Socket::SSL::SSL_Context') and
	    $ctx->{context}) {
	    # valid context
	} elsif ( $ctx = ${*$ctx}{_SSL_ctx} ) {
	    # reuse context from existing SSL object
	}
	return $ctx
    }

    # common problem forgetting to set SSL_use_cert
    # if client cert is given by user but SSL_use_cert is undef, assume that it
    # should be set
    if ( ! $is_server && ! defined $arg_hash->{SSL_use_cert}
	&& ( grep { $arg_hash->{$_} } qw(SSL_cert SSL_cert_file))
	&& ( grep { $arg_hash->{$_} } qw(SSL_key SSL_key_file)) ) {
	$arg_hash->{SSL_use_cert} = 1
    }

    # if any of SSL_ca* is set don't set the other SSL_ca*
    # from defaults
    if ( $arg_hash->{SSL_ca} ) {
	$arg_hash->{SSL_ca_file} ||= undef
	$arg_hash->{SSL_ca_path} ||= undef
    } elsif ( $arg_hash->{SSL_ca_path} ) {
	$arg_hash->{SSL_ca_file} ||= undef
    } elsif ( $arg_hash->{SSL_ca_file} ) {
	$arg_hash->{SSL_ca_path} ||= undef;
    }

    # add library defaults
    $arg_hash->{SSL_use_cert} = $is_server if ! defined $arg_hash->{SSL_use_cert};


    # Avoid passing undef arguments to Net::SSLeay
    defined($arg_hash->{$_}) or delete($arg_hash->{$_}) for(keys %$arg_hash);

    # check SSL CA, cert etc arguments
    # some apps set keys '' to signal that it is not set, replace with undef
    for (qw( SSL_cert SSL_cert_file SSL_key SSL_key_file
	SSL_ca SSL_ca_file SSL_ca_path
	SSL_fingerprint )) {
	$arg_hash->{$_} = undef if defined $arg_hash->{$_}
	    and $arg_hash->{$_} eq '';
    }
    for(qw(SSL_cert_file SSL_key_file)) {
	 defined( my $file = $arg_hash->{$_} ) or next;
	for my $f (ref($file) eq 'HASH' ? values(%$file):$file ) {
	    die "$_ $f can't be used: $!" if ! open(my $fh,'<',$f)
	}
    }

    my $verify_mode = $arg_hash->{SSL_verify_mode} || 0;
    if ( $verify_mode != $Net_SSLeay_VERIFY_NONE) {
	for (qw(SSL_ca_file SSL_ca_path)) {
	    $CHECK_SSL_PATH->($_ => $arg_hash->{$_} || next);
	}
    } elsif ( $verify_mode ne '0' ) {
	# some users use the string 'SSL_VERIFY_PEER' instead of the constant
	die "SSL_verify_mode must be a number and not a string";
    }

    my $self = bless {},$class;

    my $vcn_scheme = delete $arg_hash->{SSL_verifycn_scheme};
    my $vcn_publicsuffix = delete $arg_hash->{SSL_verifycn_publicsuffix};
    if ( ! $is_server and $verify_mode & 0x01 and
	! $vcn_scheme || $vcn_scheme ne 'none' ) {

	# gets updated during configure_SSL
	my $verify_name;
	$self->{verify_name_ref} = \$verify_name;

	my $vcb = $arg_hash->{SSL_verify_callback};
	$arg_hash->{SSL_verify_callback} = sub {
	    my ($ok,$ctx_store,$certname,$error,$cert,$depth) = @_;
	    $ok = $vcb->($ok,$ctx_store,$certname,$error,$cert,$depth) if $vcb;
	    $ok or return 0;

	    return $ok if $depth != 0;

	    my $host = $verify_name || ref($vcn_scheme) && $vcn_scheme->{callback} && 'unknown';
	    if ( ! $host ) {
		if ( $vcn_scheme ) {
		    IO::Socket::SSL->_internal_error(
			"Cannot determine peer hostname for verification",8);
		    return 0;
		}
		warn "Cannot determine hostname of peer for verification. ".
		    "Disabling default hostname verification for now. ".
		    "Please specify hostname with SSL_verifycn_name and better set SSL_verifycn_scheme too.\n";
		return $ok;
	    } elsif ( ! $vcn_scheme && $host =~m{^[\d.]+$|:} ) {
		# don't try to verify IP by default
		return $ok;
	    }


	    # verify name
	    my $rv = IO::Socket::SSL::verify_hostname_of_cert(
		$host,$cert,$vcn_scheme,$vcn_publicsuffix );
	    if ( ! $rv ) {
		IO::Socket::SSL->_internal_error(
		    "hostname verification failed",5);
	    }
	    return $rv;
	};
    }

    if ($is_server) {
	if ($arg_hash->{SSL_ticket_keycb} && !$can_tckt_keycb) {
	    warn "Ticket Key Callback is not supported - ignoring option SSL_ticket_keycb\n";
	    delete $arg_hash->{SSL_ticket_keycb};
	}
    }


    my $ssl_op = $DEFAULT_SSL_OP;

    my $ver;
    for (split(/\s*:\s*/,$arg_hash->{SSL_version})) {
	m{^(!?)(?:(SSL(?:v2|v3|v23|v2/3))|(TLSv1(?:_?[123])?))$}i
	or croak("invalid SSL_version specified");
	my $not = $1;
	( my $v = lc($2||$3) ) =~s{^(...)}{\U$1};
	if ( $not ) {
	    $ssl_op |= $SSL_OP_NO{$v};
	} else {
	    croak("cannot set multiple SSL protocols in SSL_version")
		if $ver && $v ne $ver;
	    $ver = $v;
	    $ver =~s{/}{}; # interpret SSLv2/3 as SSLv23
	    $ver =~s{(TLSv1)(\d)}{$1\_$2}; # TLSv1_1
	}
    }

    my $ctx_new_sub =
	$ver eq 'TLSv1_3' ? $CTX_tlsv1_3_new :
	UNIVERSAL::can( 'Net::SSLeay',
	    $ver eq 'SSLv2'   ? 'CTX_v2_new' :
	    $ver eq 'SSLv3'   ? 'CTX_v3_new' :
	    $ver eq 'TLSv1'   ? 'CTX_tlsv1_new' :
	    $ver eq 'TLSv1_1' ? 'CTX_tlsv1_1_new' :
	    $ver eq 'TLSv1_2' ? 'CTX_tlsv1_2_new' :
	    'CTX_new'
	)
	or return IO::Socket::SSL->_internal_error("SSL Version $ver not supported",9);

    # For SNI in server mode we need a separate context for each certificate.
    my %ctx;
    if ($is_server) {
	my %sni;
	for my $opt (qw(SSL_key SSL_key_file SSL_cert SSL_cert_file)) {
	    my $val  = $arg_hash->{$opt} or next;
	    if ( ref($val) eq 'HASH' ) {
		while ( my ($host,$v) = each %$val ) {
		    $sni{lc($host)}{$opt} = $v;
		}
	    }
	}
	while (my ($host,$v) = each %sni) {
	    $ctx{$host} = $host =~m{%} ? $v : { %$arg_hash, %$v };
	}
    }
    $ctx{''} = $arg_hash if ! %ctx;

    for my $host (sort keys %ctx) {
	my $arg_hash = delete $ctx{$host};
	my $ctx;
	if ($host =~m{^([^%]*)%}) {
	    $ctx = $ctx{$1} or return IO::Socket::SSL->error(
		"SSL Context init for $host failed - no config for $1");
	    if (my @k = grep { !m{^SSL_(?:cert|key)(?:_file)?$} }
		keys %$arg_hash) {
		return IO::Socket::SSL->error(
		    "invalid keys @k in configuration '$host' of additional certs");
	    }
	    $can_multi_cert or return IO::Socket::SSL->error(
		"no support for both RSA and ECC certificate in same context");
	    $host = $1;
	    goto just_configure_certs;
	}

	$ctx = $ctx_new_sub->() or return
	    IO::Socket::SSL->error("SSL Context init failed");
	$CTX_CREATED_IN_THIS_THREAD{$ctx} = 1 if $use_threads;
	$ctx{$host} = $ctx; # replace value in %ctx with real context

	# SSL_OP_CIPHER_SERVER_PREFERENCE
	$ssl_op |= 0x00400000 if $arg_hash->{SSL_honor_cipher_order};

	if ($ver eq 'SSLv23' && !($ssl_op & $SSL_OP_NO{SSLv3})) {
	    # At least LibreSSL disables SSLv3 by default in SSL_CTX_new.
	    # If we really want SSL3.0 we need to explicitly allow it with
	    # SSL_CTX_clear_options.
	    Net::SSLeay::CTX_clear_options($ctx,$SSL_OP_NO{SSLv3});
	}

	Net::SSLeay::CTX_set_options($ctx,$ssl_op);

	# enable X509_V_FLAG_PARTIAL_CHAIN if possible (OpenSSL 1.1.0+)
	$check_partial_chain && $check_partial_chain->($ctx);

	# if we don't set session_id_context if client certificate is expected
	# client session caching will fail
	# if user does not provide explicit id just use the stringification
	# of the context
	if($arg_hash->{SSL_server} and my $id =
	    $arg_hash->{SSL_session_id_context} ||
	    ( $arg_hash->{SSL_verify_mode} & 0x01 ) && "$ctx" ) {
	    Net::SSLeay::CTX_set_session_id_context($ctx,$id,length($id));
	}

	# SSL_MODE_ACCEPT_MOVING_WRITE_BUFFER makes syswrite return if at least one
	# buffer was written and not block for the rest
	# SSL_MODE_ENABLE_PARTIAL_WRITE can be necessary for non-blocking because we
	# cannot guarantee, that the location of the buffer stays constant
	Net::SSLeay::CTX_set_mode( $ctx,
	    SSL_MODE_ACCEPT_MOVING_WRITE_BUFFER |
	    SSL_MODE_ENABLE_PARTIAL_WRITE |
	    ($arg_hash->{SSL_mode_release_buffers} ? $ssl_mode_release_buffers : 0)
	);

	if ( my $proto_list = $arg_hash->{SSL_npn_protocols} ) {
	    return IO::Socket::SSL->_internal_error("NPN not supported in Net::SSLeay",9)
		if ! $can_npn;
	    if($arg_hash->{SSL_server}) {
		# on server side SSL_npn_protocols means a list of advertised protocols
		Net::SSLeay::CTX_set_next_protos_advertised_cb($ctx, $proto_list);
	    } else {
		# on client side SSL_npn_protocols means a list of preferred protocols
		# negotiation algorithm used is "as-openssl-implements-it"
		Net::SSLeay::CTX_set_next_proto_select_cb($ctx, $proto_list);
	    }
	}

	if ( my $proto_list = $arg_hash->{SSL_alpn_protocols} ) {
	    return IO::Socket::SSL->_internal_error("ALPN not supported in Net::SSLeay",9)
		if ! $can_alpn;
	    if($arg_hash->{SSL_server}) {
		Net::SSLeay::CTX_set_alpn_select_cb($ctx, $proto_list);
	    } else {
		Net::SSLeay::CTX_set_alpn_protos($ctx, $proto_list);
	    }
	}

	if ($arg_hash->{SSL_ticket_keycb}) {
	    my $cb = $arg_hash->{SSL_ticket_keycb};
	    ($cb,my $arg) = ref($cb) eq 'CODE' ? ($cb):@$cb;
	    Net::SSLeay::CTX_set_tlsext_ticket_getkey_cb($ctx,$cb,$arg);
	}

	# Try to apply SSL_ca even if SSL_verify_mode is 0, so that they can be
	# used to verify OCSP responses.
	# If applying fails complain only if verify_mode != VERIFY_NONE.
	if ( $arg_hash->{SSL_ca}
	    || defined $arg_hash->{SSL_ca_file}
	    || defined $arg_hash->{SSL_ca_path} ) {
	    my $file = $arg_hash->{SSL_ca_file};
	    $file = undef if ref($file) eq 'SCALAR' && ! $$file;
	    my $dir = $arg_hash->{SSL_ca_path};
	    $dir = undef if ref($dir) eq 'SCALAR' && ! $$dir;
	    if ( $arg_hash->{SSL_ca} ) {
		my $store = Net::SSLeay::CTX_get_cert_store($ctx);
		for (@{$arg_hash->{SSL_ca}}) {
		    Net::SSLeay::X509_STORE_add_cert($store,$_) or
			return IO::Socket::SSL->error(
			    "Failed to add certificate to CA store");
		}
	    }
	    $dir = join($OPENSSL_LIST_SEPARATOR,@$dir) if ref($dir);
	    if ( $file || $dir and ! Net::SSLeay::CTX_load_verify_locations(
		$ctx, $file || '', $dir || '')) {
		return IO::Socket::SSL->error(
		    "Invalid certificate authority locations")
		    if $verify_mode != $Net_SSLeay_VERIFY_NONE;
	    }
	} elsif ( my %ca = IO::Socket::SSL::default_ca()) {
	    # no CA path given, continue with system defaults
	    my $dir = $ca{SSL_ca_path};
	    $dir = join($OPENSSL_LIST_SEPARATOR,@$dir) if ref($dir);
	    if (! Net::SSLeay::CTX_load_verify_locations( $ctx,
		$ca{SSL_ca_file} || '',$dir || '')
		&& $verify_mode != $Net_SSLeay_VERIFY_NONE) {
		return IO::Socket::SSL->error(
		    "Invalid default certificate authority locations")
	    }
	}

	if ($is_server && ($verify_mode & $Net_SSLeay_VERIFY_PEER)) {
	    if ($arg_hash->{SSL_client_ca}) {
		for (@{$arg_hash->{SSL_client_ca}}) {
		    return IO::Socket::SSL->error(
			"Failed to add certificate to client CA list") if
			! Net::SSLeay::CTX_add_client_CA($ctx,$_);
		}
	    }
	    if ($arg_hash->{SSL_client_ca_file}) {
		my $list = Net::SSLeay::load_client_CA_file(
		    $arg_hash->{SSL_client_ca_file}) or
		    return IO::Socket::SSL->error(
		    "Failed to load certificate to client CA list");
		Net::SSLeay::CTX_set_client_CA_list($ctx,$list);
	    }
	}

	my $X509_STORE_flags = $DEFAULT_X509_STORE_flags;
	if ($arg_hash->{'SSL_check_crl'}) {
	    $X509_STORE_flags |= Net::SSLeay::X509_V_FLAG_CRL_CHECK();
	    if ($arg_hash->{'SSL_crl_file'}) {
		my $bio = Net::SSLeay::BIO_new_file($arg_hash->{'SSL_crl_file'}, 'r');
		my $crl = Net::SSLeay::PEM_read_bio_X509_CRL($bio);
		Net::SSLeay::BIO_free($bio);
		if ( $crl ) {
		    Net::SSLeay::X509_STORE_add_crl(Net::SSLeay::CTX_get_cert_store($ctx), $crl);
		    Net::SSLeay::X509_CRL_free($crl);
		} else {
		    return IO::Socket::SSL->error("Invalid certificate revocation list");
		}
	    }
	}

	Net::SSLeay::X509_STORE_set_flags(
	    Net::SSLeay::CTX_get_cert_store($ctx),
	    $X509_STORE_flags
	) if $X509_STORE_flags;

	Net::SSLeay::CTX_set_default_passwd_cb($ctx,$arg_hash->{SSL_passwd_cb})
	    if $arg_hash->{SSL_passwd_cb};

	just_configure_certs:
	my ($havekey,$havecert);
	if ( my $x509 = $arg_hash->{SSL_cert} ) {
	    # binary, e.g. X509*
	    # we have either a single certificate or a list with
	    # a chain of certificates
	    my @x509 = ref($x509) eq 'ARRAY' ? @$x509: ($x509);
	    my $cert = shift @x509;
	    Net::SSLeay::CTX_use_certificate( $ctx,$cert )
		|| return IO::Socket::SSL->error("Failed to use Certificate");
	    foreach my $ca (@x509) {
		Net::SSLeay::CTX_add_extra_chain_cert( $ctx,$ca )
		    || return IO::Socket::SSL->error("Failed to use Certificate");
	    }
	    $havecert = 'OBJ';
	} elsif ( my $f = $arg_hash->{SSL_cert_file} ) {
	    # try to load chain from PEM or certificate from ASN1
	    my @err;
	    if (Net::SSLeay::CTX_use_certificate_chain_file($ctx,$f)) {
		$havecert = 'PEM';
	    } elsif (do {
		push @err, [ PEM => _errstack() ];
		Net::SSLeay::CTX_use_certificate_file($ctx,$f,FILETYPE_ASN1)
	    }) {
		$havecert = 'DER';
	    } else {
		push @err, [ DER => _errstack() ];
		# try to load certificate, key and chain from PKCS12 file
		my ($key,$cert,@chain) = Net::SSLeay::P_PKCS12_load_file($f,1);
		if (!$cert and $arg_hash->{SSL_passwd_cb}
		    and defined( my $pw = $arg_hash->{SSL_passwd_cb}->(0))) {
		    ($key,$cert,@chain) = Net::SSLeay::P_PKCS12_load_file($f,1,$pw);
		}
		PKCS12: while ($cert) {
		    Net::SSLeay::CTX_use_certificate($ctx,$cert) or last;
		    # Net::SSLeay::P_PKCS12_load_file is implemented using
		    # OpenSSL PKCS12_parse which according to the source code
		    # returns the chain with the last CA certificate first (i.e.
		    # reverse order as in the PKCS12 file). This is not
		    # documented but given the age of this function we'll assume
		    # that this will stay this way in the future.
		    while (my $ca = pop @chain) {
			Net::SSLeay::CTX_add_extra_chain_cert($ctx,$ca)
			    or last PKCS12;
		    }
		    last if $key && ! Net::SSLeay::CTX_use_PrivateKey($ctx,$key);
		    $havecert = 'PKCS12';
		    last;
		}
		$havekey = 'PKCS12' if $key;
		Net::SSLeay::X509_free($cert) if $cert;
		Net::SSLeay::EVP_PKEY_free($key) if $key;
		# don't free @chain, because CTX_add_extra_chain_cert
		# did not duplicate the certificates
	    }
	    if (!$havecert) {
		push @err, [ PKCS12 => _errstack() ];
		my $err = "Failed to load certificate from file $f:";
		for(@err) {
		    my ($type,@e) = @$_;
		    $err .= " [format:$type] @e **" if @e;
		}
		return IO::Socket::SSL->error($err);
	    }
	}

	if (!$havecert || $havekey) {
	    # skip SSL_key_*
	} elsif ( my $pkey = $arg_hash->{SSL_key} ) {
	    # binary, e.g. EVP_PKEY*
	    Net::SSLeay::CTX_use_PrivateKey($ctx, $pkey)
		|| return IO::Socket::SSL->error("Failed to use Private Key");
	    $havekey = 'MEM';
	} elsif ( my $f = $arg_hash->{SSL_key_file}
	    || (($havecert eq 'PEM') ? $arg_hash->{SSL_cert_file}:undef) ) {
	    for my $ft ( FILETYPE_PEM, FILETYPE_ASN1 ) {
		if (Net::SSLeay::CTX_use_PrivateKey_file($ctx,$f,$ft)) {
		    $havekey = ($ft == FILETYPE_PEM) ? 'PEM':'DER';
		    last;
		}
	    }
	    $havekey or return IO::Socket::SSL->error(
		"Failed to load key from file (no PEM or DER)");
	}

	Net::SSLeay::CTX_set_post_handshake_auth($ctx,1)
	    if (!$is_server && $can_pha && $havecert && $havekey);
    }

    if ($arg_hash->{SSL_server}) {

	if ( my $f = $arg_hash->{SSL_dh_file} ) {
	    my $bio = Net::SSLeay::BIO_new_file( $f,'r' )
		|| return IO::Socket::SSL->error( "Failed to open DH file $f" );
	    my $dh = Net::SSLeay::PEM_read_bio_DHparams($bio);
	    Net::SSLeay::BIO_free($bio);
	    $dh || return IO::Socket::SSL->error( "Failed to read PEM for DH from $f - wrong format?" );
	    my $rv;
	    for (values (%ctx)) {
		$rv = Net::SSLeay::CTX_set_tmp_dh( $_,$dh ) or last;
	    }
	    Net::SSLeay::DH_free( $dh );
	    $rv || return IO::Socket::SSL->error( "Failed to set DH from $f" );
	} elsif ( my $dh = $arg_hash->{SSL_dh} ) {
	    # binary, e.g. DH*

	    for( values %ctx ) {
		Net::SSLeay::CTX_set_tmp_dh( $_,$dh ) || return
		    IO::Socket::SSL->error( "Failed to set DH from SSL_dh" );
	    }
	}
    }

    if ( my $curve = $arg_hash->{SSL_ecdh_curve} ) {
	return IO::Socket::SSL->_internal_error(
	    "ECDH curve needs Net::SSLeay>=1.56 and OpenSSL>=1.0",9)
	    if ! $can_ecdh;

	for(values %ctx) {
	    if ($arg_hash->{SSL_server} and $curve eq 'auto') {
		if ($can_ecdh eq 'can_auto') {
			Net::SSLeay::CTX_set_ecdh_auto($_,1) or
			    return IO::Socket::SSL->error(
			    "failed to set ECDH curve context");
		} elsif ($can_ecdh eq 'auto') {
		    # automatically enabled anyway
		} else {
		    return IO::Socket::SSL->error(
			"SSL_CTX_set_ecdh_auto not implemented");
		}

	    } elsif ($set_groups_list) {
		$set_groups_list->($_,$curve) or return IO::Socket::SSL->error(
		    "failed to set ECDH groups/curves on context");
		# needed for OpenSSL 1.0.2 if ($can_ecdh eq 'can_auto') {
		Net::SSLeay::CTX_set_ecdh_auto($_,1) if $can_ecdh eq 'can_auto';
	    } elsif ($curve =~m{:}) {
		return IO::Socket::SSL->error(
		    "SSL_CTX_groups_list or SSL_CTX_curves_list not implemented");

	    } elsif ($arg_hash->{SSL_server}) {
		if ( $curve !~ /^\d+$/ ) {
		    # name of curve, find NID
		    $curve = Net::SSLeay::OBJ_txt2nid($curve)
			|| return IO::Socket::SSL->error(
			"cannot find NID for curve name '$curve'");
		}
		my $ecdh = Net::SSLeay::EC_KEY_new_by_curve_name($curve) or
		    return IO::Socket::SSL->error(
		    "cannot create curve for NID $curve");
		for( values %ctx ) {
		    Net::SSLeay::CTX_set_tmp_ecdh($_,$ecdh) or
			return IO::Socket::SSL->error(
			"failed to set ECDH curve context");
		}
		Net::SSLeay::EC_KEY_free($ecdh);
	    }
	}
    }

    my $verify_cb = $arg_hash->{SSL_verify_callback};
    my @accept_fp;
    if ( my $fp = $arg_hash->{SSL_fingerprint} ) {
	for( ref($fp) ? @$fp : $fp) {
	    my ($algo,$pubkey,$digest) = m{^(?:([\w-]+)\$)?(pub\$)?([a-f\d:]+)$}i
		or return IO::Socket::SSL->_internal_error("invalid fingerprint '$_'",9);
	    ( $digest = lc($digest) ) =~s{:}{}g;
	    $algo ||=
		length($digest) == 32 ? 'md5' :
		length($digest) == 40 ? 'sha1' :
		length($digest) == 64 ? 'sha256' :
		return IO::Socket::SSL->_internal_error(
		    "cannot detect hash algorithm from fingerprint '$_'",9);
	    $algo = lc($algo);
	    push @accept_fp,[ $algo, $pubkey || '', pack('H*',$digest) ]
	}
    }
    my $verify_fingerprint = @accept_fp && do {
	my $fail;
	sub {
	    my ($ok,$cert,$depth) = @_;
	    $fail = 1 if ! $ok;
	    return 1 if $depth>0; # to let us continue with verification
	    # Check fingerprint only from top certificate.
	    my %fp;
	    for(@accept_fp) {
		my $fp = $fp{$_->[0],$_->[1]} ||= $_->[1]
		    ? Net::SSLeay::X509_pubkey_digest($cert,$algo2digest->($_->[0]))
		    : Net::SSLeay::X509_digest($cert,$algo2digest->($_->[0]));
		next if $fp ne $_->[2];
		return 1;
	    }
	    return ! $fail;
	}
    };
    my $verify_callback = ( $verify_cb || @accept_fp ) && sub {
	my ($ok, $ctx_store) = @_;
	my ($certname,$cert,$error,$depth);
	if ($ctx_store) {
	    $cert  = Net::SSLeay::X509_STORE_CTX_get_current_cert($ctx_store);
	    $error = Net::SSLeay::X509_STORE_CTX_get_error($ctx_store);
	    $depth = Net::SSLeay::X509_STORE_CTX_get_error_depth($ctx_store);
	    $certname =
		Net::SSLeay::X509_NAME_oneline(Net::SSLeay::X509_get_issuer_name($cert)).
		Net::SSLeay::X509_NAME_oneline(Net::SSLeay::X509_get_subject_name($cert));
	    $error &&= Net::SSLeay::ERR_error_string($error);
	}
	$DEBUG>=3 && DEBUG( "ok=$ok [$depth] $certname" );
	$ok = $verify_cb->($ok,$ctx_store,$certname,$error,$cert,$depth) if $verify_cb;
	$ok = $verify_fingerprint->($ok,$cert,$depth) if $verify_fingerprint && $cert;
	return $ok;
    };

    if ( $^O eq 'darwin' ) {
	# explicitly set error code to disable use of apples TEA patch
	# https://hynek.me/articles/apple-openssl-verification-surprises/
	my $vcb = $verify_callback;
	$verify_callback = sub {
	    my $rv = $vcb ? &$vcb : $_[0];
	    if ( $rv != 1 ) {
		# 50 - X509_V_ERR_APPLICATION_VERIFICATION: application verification failure
		Net::SSLeay::X509_STORE_CTX_set_error($_[1], 50);
	    }
	    return $rv;
	};
    }
    Net::SSLeay::CTX_set_verify($_, $verify_mode, $verify_callback)
	for (values %ctx);

    my $staple_callback = $arg_hash->{SSL_ocsp_staple_callback};
    if ( !$is_server && $can_ocsp_staple && ! $verify_fingerprint) {
	$self->{ocsp_cache} = $arg_hash->{SSL_ocsp_cache};
	my $status_cb = sub {
	    my ($ssl,$resp) = @_;
	    my $iossl = $SSL_OBJECT{$ssl} or
		die "no IO::Socket::SSL object found for SSL $ssl";
	    $iossl->[1] and do {
		# we must return with 1 or it will be called again
		# and because we have no SSL object we must make the error global
		Carp::cluck($IO::Socket::SSL::SSL_ERROR
		    = "OCSP callback on server side");
		return 1;
	    };
	    $iossl = $iossl->[0];

	    # if we have a callback use this
	    # callback must not free or copy $resp !!
	    if ( $staple_callback ) {
		$staple_callback->($iossl,$resp);
		return 1;
	    }

	    # default callback does verification
	    if ( ! $resp ) {
		$DEBUG>=3 && DEBUG("did not get stapled OCSP response");
		return 1;
	    }
	    $DEBUG>=3 && DEBUG("got stapled OCSP response");
	    my $status = Net::SSLeay::OCSP_response_status($resp);
	    if ($status != Net::SSLeay::OCSP_RESPONSE_STATUS_SUCCESSFUL()) {
		$DEBUG>=3 && DEBUG("bad status of stapled OCSP response: ".
		    Net::SSLeay::OCSP_response_status_str($status));
		return 1;
	    }
	    if (!eval { Net::SSLeay::OCSP_response_verify($ssl,$resp) }) {
		$DEBUG>=3 && DEBUG("verify of stapled OCSP response failed");
		return 1;
	    }
	    my (@results,$hard_error);
	    my @chain = $iossl->peer_certificates;
	    for my $cert (@chain) {
		my $certid = eval { Net::SSLeay::OCSP_cert2ids($ssl,$cert) };
		if (!$certid) {
		    $DEBUG>=3 && DEBUG("cannot create OCSP_CERTID: $@");
		    push @results,[-1,$@];
		    last;
		}
		($status) = Net::SSLeay::OCSP_response_results($resp,$certid);
		if ($status && $status->[2]) {
		    my $cache = ${*$iossl}{_SSL_ctx}{ocsp_cache};
		    if (!$status->[1]) {
			push @results,[1,$status->[2]{nextUpdate}];
			$cache && $cache->put($certid,$status->[2]);
		    } elsif ( $status->[2]{statusType} ==
			Net::SSLeay::V_OCSP_CERTSTATUS_GOOD()) {
			push @results,[1,$status->[2]{nextUpdate}];
			$cache && $cache->put($certid,{
			    %{$status->[2]},
			    expire => time()+120,
			    soft_error => $status->[1],
			});
		    } else {
			push @results,($hard_error = [0,$status->[1]]);
			$cache && $cache->put($certid,{
			    %{$status->[2]},
			    hard_error => $status->[1],
			});
		    }
		}
	    }
	    # return result of lead certificate, this should be in chain[0] and
	    # thus result[0], but we better check. But if we had any hard_error
	    # return this instead
	    if ($hard_error) {
		${*$iossl}{_SSL_ocsp_verify} = $hard_error;
	    } elsif (@results and $chain[0] == $iossl->peer_certificate) {
		${*$iossl}{_SSL_ocsp_verify} = $results[0];
	    }
	    return 1;
	};
	Net::SSLeay::CTX_set_tlsext_status_cb($_,$status_cb) for (values %ctx);
    }

    if ( my $cl = $arg_hash->{SSL_cipher_list} ) {
	for (keys %ctx) {
	    Net::SSLeay::CTX_set_cipher_list($ctx{$_}, ref($cl)
		? $cl->{$_} || $cl->{''} || $DEFAULT_SSL_ARGS{SSL_cipher_list} || next
		: $cl
	    ) || return IO::Socket::SSL->error("Failed to set SSL cipher list");
	}
    }
    if ( my $cl = $arg_hash->{SSL_ciphersuites} ) {
	return IO::Socket::SSL->error("no support for SSL_ciphersuites in Net::SSLeay")
	    if ! $can_ciphersuites;
	for (keys %ctx) {
	    Net::SSLeay::CTX_set_ciphersuites($ctx{$_}, ref($cl)
		? $cl->{$_} || $cl->{''} || $DEFAULT_SSL_ARGS{SSL_cipher_list} || next
		: $cl
	    ) || return IO::Socket::SSL->error("Failed to set SSL cipher list");
	}
    }

    # Main context is default context or any other if no default context.
    my $ctx = $ctx{''} || (values %ctx)[0];
    if (keys(%ctx) > 1 || ! exists $ctx{''}) {
	$can_server_sni or return IO::Socket::SSL->_internal_error(
	    "Server side SNI not supported for this openssl/Net::SSLeay",9);

	Net::SSLeay::CTX_set_tlsext_servername_callback($ctx, sub {
	    my $ssl = shift;
	    my $host = Net::SSLeay::get_servername($ssl);
	    $host = '' if ! defined $host;
	    my $snictx = $ctx{lc($host)} || $ctx{''} or do {
		$DEBUG>1 and DEBUG(
		    "cannot get context from servername '$host'");
		return 2; # SSL_TLSEXT_ERR_ALERT_FATAL
	    };
	    $DEBUG>1 and DEBUG("set context from servername $host");
	    Net::SSLeay::set_SSL_CTX($ssl,$snictx) if $snictx != $ctx;
	    return 0; # SSL_TLSEXT_ERR_OK
	});
    }

    if ( my $cb = $arg_hash->{SSL_create_ctx_callback} ) {
	$cb->($_) for values (%ctx);
    }

    $self->{context} = $ctx;
    $self->{verify_mode} = $arg_hash->{SSL_verify_mode};
    $self->{ocsp_mode} =
	defined($arg_hash->{SSL_ocsp_mode}) ? $arg_hash->{SSL_ocsp_mode} :
	$self->{verify_mode} ? IO::Socket::SSL::SSL_OCSP_TRY_STAPLE() :
	0;
    $DEBUG>=3 && DEBUG( "new ctx $ctx" );

    if ( my $cache = $arg_hash->{SSL_session_cache} ) {
	# use predefined cache
	$self->{session_cache} = $cache
    } elsif ( my $size = $arg_hash->{SSL_session_cache_size}) {
	$self->{session_cache} = IO::Socket::SSL::Session_Cache->new( $size );
    }


    if ($self->{session_cache} and %sess_cb) {
	Net::SSLeay::CTX_set_session_cache_mode($ctx,
	    Net::SSLeay::SESS_CACHE_CLIENT());
	my $cache = $self->{session_cache};
	$sess_cb{new}($ctx, sub {
	    my ($ssl,$session) = @_;
	    my $self = ($SSL_OBJECT{$ssl} || do {
		warn "callback session new: no known SSL object for $ssl";
		return;
	    })->[0];
	    my $args = ${*$self}{_SSL_arguments};
	    my $key = $args->{SSL_session_key} or do {
		warn "callback session new: no known SSL_session_key for $ssl";
		return;
	    };
	    $DEBUG>=3 && DEBUG("callback session new <$key> $session");
	    Net::SSLeay::SESSION_up_ref($session);
	    $cache->add_session($key,$session);
	});
	$sess_cb{remove}($ctx, sub {
	    my ($ctx,$session) = @_;
	    $DEBUG>=3 && DEBUG("callback session remove $session");
	    $cache->del_session(undef,$session);
	});
    }

    return $self;
}


sub has_session_cache {
    return defined shift->{session_cache};
}


sub CLONE { %CTX_CREATED_IN_THIS_THREAD = (); }
sub DESTROY {
    my $self = shift;
    if ( my $ctx = $self->{context} ) {
	$DEBUG>=3 && DEBUG("free ctx $ctx open=".join( " ",keys %CTX_CREATED_IN_THIS_THREAD ));
	if (!$use_threads or delete $CTX_CREATED_IN_THIS_THREAD{$ctx} ) {
	    # remove any verify callback for this context
	    if ( $self->{verify_mode}) {
		$DEBUG>=3 && DEBUG("free ctx $ctx callback" );
		Net::SSLeay::CTX_set_verify($ctx, 0,undef);
	    }
	    if ( $self->{ocsp_error_ref}) {
		$DEBUG>=3 && DEBUG("free ctx $ctx tlsext_status_cb" );
		Net::SSLeay::CTX_set_tlsext_status_cb($ctx,undef);
	    }
	    $DEBUG>=3 && DEBUG("OK free ctx $ctx" );
	    Net::SSLeay::CTX_free($ctx);
	}
    }
    delete(@{$self}{'context','session_cache'});
}

package IO::Socket::SSL::Session_Cache;
*DEBUG = *IO::Socket::SSL::DEBUG;
use constant {
    SESSION => 0,
    KEY     => 1,
    GNEXT   => 2,
    GPREV   => 3,
    SNEXT   => 4,
    SPREV   => 5,
};

sub new {
    my ($class, $size) = @_;
    $size>0 or return;
    return bless {
	room  => $size,
	ghead => undef,
	shead => {},
    }, $class;
}

sub add_session {
    my ($self, $key, $session) = @_;

    # create new
    my $v = [];
    $v->[SESSION] = $session;
    $v->[KEY] = $key;
    $DEBUG>=3 && DEBUG("add_session($key,$session)");
    _add_entry($self,$v);
}

sub replace_session {
    my ($self, $key, $session) = @_;
    $self->del_session($key);
    $self->add_session($key, $session);
}

sub del_session {
    my ($self, $key, $session) = @_;
    my ($head,$inext) = $key
	? ($self->{shead}{$key},SNEXT) : ($self->{ghead},GNEXT);
    my $v = $head;
    my @del;
    while ($v) {
	if (!$session) {
	    push @del,$v
	} elsif ($v->[SESSION] == $session) {
	    push @del, $v;
	    last;
	}
	$v = $v->[$inext];
	last if $v == $head;
    }
    $DEBUG>=3 && DEBUG("del_session("
	. ($key ? $key : "undef")
	. ($session ? ",$session) -> " : ") -> ")
	.  (~~@del || 'none'));
    for (@del) {
	_del_entry($self,$_);
	Net::SSLeay::SESSION_free($_->[SESSION]) if $_->[SESSION];
    }
    return ~~@del;
}

sub get_session {
    my ($self, $key, $session) = @_;
    my $v = $self->{shead}{$key};
    if ($session) {
	my $shead = $v;
	while ($v) {
	    $DEBUG>=3 && DEBUG("check $session - $v->[SESSION]");
	    last if $v->[SESSION] == $session;
	    $v = $v->[SNEXT];
	    $v = undef if $v == $shead; # session not found
	}
    }
    if ($v) {
	_del_entry($self, $v); # remove
	_add_entry($self, $v); # and add back on top
    }
    $DEBUG>=3 && DEBUG("get_session($key"
	. ( $session ? ",$session) -> " : ") -> ")
	. ($v? $v->[SESSION]:"none"));
    return $v && $v->[SESSION];
}

sub _add_entry {
    my ($self,$v) = @_;
    for(
	[ SNEXT, SPREV, \$self->{shead}{$v->[KEY]} ],
	[ GNEXT, GPREV, \$self->{ghead} ],
    ) {
	my ($inext,$iprev,$rhead) = @$_;
	if ($$rhead) {
	    $v->[$inext] = $$rhead;
	    $v->[$iprev] = ${$rhead}->[$iprev];
	    ${$rhead}->[$iprev][$inext] = $v;
	    ${$rhead}->[$iprev] = $v;
	} else {
	    $v->[$inext] = $v->[$iprev] = $v;
	}
	$$rhead = $v;
    }

    $self->{room}--;

    # drop old entries if necessary
    if ($self->{room}<0) {
	my $l = $self->{ghead}[GPREV];
	_del_entry($self,$l);
	Net::SSLeay::SESSION_free($l->[SESSION]) if $l->[SESSION];
    }
}

sub _del_entry {
    my ($self,$v) = @_;
    for(
	[ SNEXT, SPREV, \$self->{shead}{$v->[KEY]} ],
	[ GNEXT, GPREV, \$self->{ghead} ],
    ) {
	my ($inext,$iprev,$rhead) = @$_;
	$$rhead or return;
	$v->[$inext][$iprev] = $v->[$iprev];
	$v->[$iprev][$inext] = $v->[$inext];
	if ($v != $$rhead) {
	    # not removed from top of list
	} elsif ($v->[$inext] == $v) {
	    # was only element on list, drop list
	    if ($inext == SNEXT) {
		delete $self->{shead}{$v->[KEY]};
	    } else {
		$$rhead = undef;
	    }
	} else {
	    # was top element, keep others
	    $$rhead = $v->[$inext];
	}
    }
    $self->{room}++;
}

sub _dump {
    my $self = shift;

    my %v2i;
    my $v = $self->{ghead};
    while ($v) {
	exists $v2i{$v} and die;
	$v2i{$v} = int(keys %v2i);
	$v = $v->[GNEXT];
	last if $v == $self->{ghead};
    }

    my $out = "room: $self->{room}\nghead:\n";
    $v = $self->{ghead};
    while ($v) {
	$out .= sprintf(" - [%d] <%d,%d> '%s' <%s>\n",
	    $v2i{$v}, $v2i{$v->[GPREV]}, $v2i{$v->[GNEXT]},
	    $v->[KEY], $v->[SESSION]);
	$v = $v->[GNEXT];
	last if $v == $self->{ghead};
    }
    $out .= "shead:\n";
    for my $key (sort keys %{$self->{shead}}) {
	$out .= " - '$key'\n";
	my $shead = $self->{shead}{$key};
	my $v = $shead;
	while ($v) {
	    $out .= sprintf("   - [%d] <%d,%d> '%s' <%s>\n",
		$v2i{$v}, $v2i{$v->[SPREV]}, $v2i{$v->[SNEXT]},
		$v->[KEY], $v->[SESSION]);
	    $v = $v->[SNEXT];
	    last if $v == $shead;
	}
    }
    return $out;
}

sub DESTROY {
    my $self = shift;
    delete $self->{shead};
    my $v = delete $self->{ghead};
    while ($v) {
	Net::SSLeay::SESSION_free($v->[SESSION]) if $v->[SESSION];
	my $next = $v->[GNEXT];
	@$v = ();
	$v = $next;
    }
}



package IO::Socket::SSL::OCSP_Cache;

sub new {
    my ($class,$size) = @_;
    return bless {
	'' => { _lru => 0, size => $size || 100 }
    },$class;
}
sub get {
    my ($self,$id) = @_;
    my $e = $self->{$id} or return;
    $e->{_lru} = $self->{''}{_lru}++;
    if ( $e->{expire} && time()<$e->{expire}) {
	delete $self->{$id};
	return;
    }
    if ( $e->{nextUpdate} && time()<$e->{nextUpdate} ) {
	delete $self->{$id};
	return;
    }
    return $e;
}

sub put {
    my ($self,$id,$e) = @_;
    $self->{$id} = $e;
    $e->{_lru} = $self->{''}{_lru}++;
    my $del = keys(%$self) - $self->{''}{size};
    if ($del>0) {
	my @k = sort { $self->{$a}{_lru} <=> $self->{$b}{_lru} } keys %$self;
	delete @{$self}{ splice(@k,0,$del) };
    }
    return $e;
}

package IO::Socket::SSL::OCSP_Resolver;
*DEBUG = *IO::Socket::SSL::DEBUG;

# create a new resolver
# $ssl - the ssl object
# $cache - OCSP_Cache object (put,get)
# $failhard - flag if we should fail hard on OCSP problems
# $certs - list of certs to verify
sub new {
    my ($class,$ssl,$cache,$failhard,$certs) = @_;
    my (%todo,$done,$hard_error,@soft_error);
    for my $cert (@$certs) {
	# skip entries which have no OCSP uri or where we cannot get a certid
	# (e.g. self-signed or where we don't have the issuer)
	my $subj = Net::SSLeay::X509_NAME_oneline(Net::SSLeay::X509_get_subject_name($cert));
	my $uri = Net::SSLeay::P_X509_get_ocsp_uri($cert) or do {
	    $DEBUG>2 && DEBUG("no URI for certificate $subj");
	    push @soft_error,"no ocsp_uri for $subj";
	    next;
	};
	my $certid = eval { Net::SSLeay::OCSP_cert2ids($ssl,$cert) } or do {
	    $DEBUG>2 && DEBUG("no OCSP_CERTID for certificate $subj: $@");
	    push @soft_error,"no certid for $subj: $@";
	    next;
	};
	if (!($done = $cache->get($certid))) {
	    push @{ $todo{$uri}{ids} }, $certid;
	    push @{ $todo{$uri}{subj} }, $subj;
	} elsif ( $done->{hard_error} ) {
	    # one error is enough to fail validation
	    $hard_error = $done->{hard_error};
	    %todo = ();
	    last;
	} elsif ( $done->{soft_error} ) {
	    push @soft_error,$done->{soft_error};
	}
    }
    while ( my($uri,$v) = each %todo) {
	my $ids = $v->{ids};
	$v->{req} = Net::SSLeay::i2d_OCSP_REQUEST(
	    Net::SSLeay::OCSP_ids2req(@$ids));
    }
    $hard_error ||= '' if ! %todo;
    return bless {
	ssl => $ssl,
	cache => $cache,
	failhard => $failhard,
	hard_error => $hard_error,
	soft_error => @soft_error ? join("; ",@soft_error) : undef,
	todo => \%todo,
    },$class;
}

# return current result, e.g. '' for no error, else error
# if undef we have no final result yet
sub hard_error { return shift->{hard_error} }
sub soft_error { return shift->{soft_error} }

# return hash with uri => ocsp_request_data for open requests
sub requests {
    my $todo = shift()->{todo};
    return map { ($_,$todo->{$_}{req}) } keys %$todo;
}

# add new response
sub add_response {
    my ($self,$uri,$resp) = @_;
    my $todo = delete $self->{todo}{$uri};
    return $self->{error} if ! $todo || $self->{error};

    my ($req,@soft_error,@hard_error);

    # do we have a response
    if (!$resp) {
	@soft_error = "http request for OCSP failed; subject: ".
	    join("; ",@{$todo->{subj}});

    # is it a valid OCSP_RESPONSE
    } elsif ( ! eval { $resp = Net::SSLeay::d2i_OCSP_RESPONSE($resp) }) {
	@soft_error = "invalid response (no OCSP_RESPONSE); subject: ".
	    join("; ",@{$todo->{subj}});
	# hopefully short-time error
	$self->{cache}->put($_,{
	    soft_error => "@soft_error",
	    expire => time()+10,
	}) for (@{$todo->{ids}});
    # is the OCSP response status success
    } elsif (
	( my $status = Net::SSLeay::OCSP_response_status($resp))
	    != Net::SSLeay::OCSP_RESPONSE_STATUS_SUCCESSFUL()
    ){
	@soft_error = "OCSP response failed: ".
	    Net::SSLeay::OCSP_response_status_str($status).
	    "; subject: ".join("; ",@{$todo->{subj}});
	# hopefully short-time error
	$self->{cache}->put($_,{
	    soft_error => "@soft_error",
	    expire => time()+10,
	}) for (@{$todo->{ids}});

    # does nonce match the request and can the signature be verified
    } elsif ( ! eval {
	$req = Net::SSLeay::d2i_OCSP_REQUEST($todo->{req});
	Net::SSLeay::OCSP_response_verify($self->{ssl},$resp,$req);
    }) {
	if ($@) {
	    @soft_error = $@
	} else {
	    my @err;
	    while ( my $err = Net::SSLeay::ERR_get_error()) {
		push @soft_error, Net::SSLeay::ERR_error_string($err);
	    }
	    @soft_error = 'failed to verify OCSP response; subject: '.
		join("; ",@{$todo->{subj}}) if ! @soft_error;
	}
	# configuration problem or we don't know the signer
	$self->{cache}->put($_,{
	    soft_error => "@soft_error",
	    expire => time()+120,
	}) for (@{$todo->{ids}});

    # extract results from response
    } elsif ( my @result =
	Net::SSLeay::OCSP_response_results($resp,@{$todo->{ids}})) {
	my (@found,@miss);
	for my $rv (@result) {
	    if ($rv->[2]) {
		push @found,$rv->[0];
		if (!$rv->[1]) {
		    # no error
		    $self->{cache}->put($rv->[0],$rv->[2]);
		} elsif ( $rv->[2]{statusType} ==
		    Net::SSLeay::V_OCSP_CERTSTATUS_GOOD()) {
		    # soft error, like response after nextUpdate
		    push @soft_error,$rv->[1]."; subject: ".
			join("; ",@{$todo->{subj}});
		    $self->{cache}->put($rv->[0],{
			%{$rv->[2]},
			soft_error => "@soft_error",
			expire => time()+120,
		    });
		} else {
		    # hard error
		    $self->{cache}->put($rv->[0],$rv->[2]);
		    push @hard_error, $rv->[1]."; subject: ".
			join("; ",@{$todo->{subj}});
		}
	    } else {
		push @miss,$rv->[0];
	    }
	}
	if (@miss && @found) {
	    # we sent multiple responses, but server answered only to one
	    # try again
	    $self->{todo}{$uri} = $todo;
	    $todo->{ids} = \@miss;
	    $todo->{req} = Net::SSLeay::i2d_OCSP_REQUEST(
		Net::SSLeay::OCSP_ids2req(@miss));
	    $DEBUG>=2 && DEBUG("$uri just answered ".@found." of ".(@found+@miss)." requests");
	}
    } else {
	@soft_error = "no data in response; subject: ".
	    join("; ",@{$todo->{subj}});
	# probably configuration problem
	$self->{cache}->put($_,{
	    soft_error => "@soft_error",
	    expire => time()+120,
	}) for (@{$todo->{ids}});
    }

    Net::SSLeay::OCSP_REQUEST_free($req) if $req;
    if ($self->{failhard}) {
	push @hard_error,@soft_error;
	@soft_error = ();
    }
    if (@soft_error) {
	$self->{soft_error} .= "; " if $self->{soft_error};
	$self->{soft_error} .= "$uri: ".join('; ',@soft_error);
    }
    if (@hard_error) {
	$self->{hard_error} = "$uri: ".join('; ',@hard_error);
	%{$self->{todo}} = ();
    } elsif ( ! %{$self->{todo}} ) {
	$self->{hard_error} = ''
    }
    return $self->{hard_error};
}

# make all necessary requests to get OCSP responses blocking
sub resolve_blocking {
    my ($self,%args) = @_;
    while ( my %todo = $self->requests ) {
	eval { require HTTP::Tiny } or die "need HTTP::Tiny installed";
	# OCSP responses have their own signature, so we don't need SSL verification
	my $ua = HTTP::Tiny->new(verify_SSL => 0,%args);
	while (my ($uri,$reqdata) = each %todo) {
	    $DEBUG && DEBUG("sending OCSP request to $uri");
	    my $resp = $ua->request('POST',$uri, {
		headers => { 'Content-type' => 'application/ocsp-request' },
		content => $reqdata
	    });
	    $DEBUG && DEBUG("got  OCSP response from $uri code=$resp->{status}");
	    defined ($self->add_response($uri,
		$resp->{success} && $resp->{content}))
		&& last;
	}
    }
    $DEBUG>=2 && DEBUG("no more open OCSP requests");
    return $self->{hard_error};
}

1;

__END__
                                                                                                                                                                                                                                                                                              Socket/SSL/PublicSuffix.pm                                                                          0000644                 00000740503 00000000000 0011350 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       
use strict;
use warnings;
package IO::Socket::SSL::PublicSuffix;
use Carp;

# for updates
use constant URL => 'http://publicsuffix.org/list/effective_tld_names.dat';

=head1 NAME

IO::Socket::SSL::PublicSuffix - provide access to Mozilla's list of effective TLD names

=head1 SYNOPSIS

    # use builtin default
    use IO::Socket::SSL::PublicSuffix;
    $ps = IO::Socket::SSL::PublicSuffix->default;

    # load from string
    $ps = IO::Socket::SSL::PublicSuffix->from_string("*.uk\n*");

    # load from file or file handle
    $ps = IO::Socket::SSL::PublicSuffix->from_file($filename);
    $ps = IO::Socket::SSL::PublicSuffix->from_file(\*STDIN);


    # --- string in -> string out
    # $rest -> whatever.host
    # $tld  -> co.uk
    my ($rest,$tld) = $ps->public_suffix('whatever.host.co.uk');
    my $tld = $ps->public_suffix('whatever.host.co.uk');

    # $root_domain -> host.co.uk
    my $root_domain = $ps->public_suffix('whatever.host.co.uk', 1);

    # --- array in -> array out
    # $rest -> [qw(whatever host)]
    # $tld  -> [qw(co uk)]
    my ($rest,$tld) = $ps->public_suffix([qw(whatever host co uk)]);

 ----

    # To update this file with the current list:
    perl -MIO::Socket::SSL::PublicSuffix -e 'IO::Socket::SSL::PublicSuffix::update_self_from_url()'



=head1 DESCRIPTION

This module uses the list of effective top level domain names from the mozilla
project to determine the public top level domain for a given hostname.

=head2 Method

=over 4

=item class->default(%args)

Returns object with builtin default.
C<min_suffix> can be given in C<%args> to specify the minimal suffix, default
is 1.

=item class->from_string(string,%args)

Returns object with configuration from string.
See method C<default> for C<%args>.

=item class->from_file( file name| file handle, %args )

Returns object with configuration from file or file handle.
See method C<default> for C<%args>.

=item $self->public_suffix( $host|\@host, [ $add ] )

In array context the function returns the non-tld part and the tld part of the
given hostname, in scalar context only the tld part.
It adds C<$add> parts of the non-tld part to the tld, e.g. with C<$add=1> it
will return the root domain.

If there were no explicit matches against the public suffix configuration it
will fall back to a suffix of length 1.

The function accepts a string or an array-ref (e.g. host split by C<.>). In the
first case it will return string(s), in the latter case array-ref(s).

International hostnames or labels can be in ASCII (IDNA form starting with
C<xn-->) or unicode. In the latter case an IDNA handling library needs to be
available.  L<URI> is preferred, but L<Net::IDN:::Encode>, L<Net::LibIDN> are
still supported.

=item ($self|class)->can_idn

Returns true if IDN support is available.

=back

=head1 FILES

http://publicsuffix.org/list/effective_tld_names.dat

=head1 SEE ALSO

Domain::PublicSuffix, Mozilla::PublicSuffix

=head1 BUGS

 Q: Why yet another module, we already have L<Domain::PublicSuffix> and
    L<Mozilla::PublicSuffix>.
 A: Because the public suffix data change more often than these modules do,
    IO::Socket::SSL needs this list and it is more easy this way to keep it
    up-to-date.


=head1 AUTHOR

Steffen Ullrich

=cut


BEGIN {
    if ( eval {
	require URI::_idna;
	defined &URI::_idna::encode && defined &URI::_idna::decode
    }) {
	*idn_to_ascii   = \&URI::_idna::encode;
	*idn_to_unicode = \&URI::_idna::decode;
	*can_idn = sub { 1 };
    } elsif ( eval { require Net::IDN::Encode } ) {
	*idn_to_ascii   = \&Net::IDN::Encode::domain_to_ascii;
	*idn_to_unicode = \&Net::IDN::Encode::domain_to_unicode;
	*can_idn = sub { 1 };
    } elsif ( eval { require Net::LibIDN; require Encode } ) {
	# Net::LibIDN does not use utf-8 flag and expects raw data
	*idn_to_ascii   = sub { 
	    Net::LibIDN::idn_to_ascii(Encode::encode('utf-8',$_[0]),'utf-8');
	},
	*idn_to_unicode = sub { 
	    Encode::decode('utf-8',Net::LibIDN::idn_to_unicode($_[0],'utf-8'));
	},
	*can_idn = sub { 1 };
    } else {
	*idn_to_ascii   = sub { croak "idn_to_ascii(@_) - no IDNA library installed" };
	*idn_to_unicode = sub { croak "idn_to_unicode(@_) - no IDNA library installed" };
	*can_idn = sub { 0 };
    }
}

{
    my %default;
    sub default {
	my (undef,%args) = @_;
	my $min_suffix = delete $args{min_suffix};
	$min_suffix = 1 if ! defined $min_suffix;
	%args and die "unknown args: ".join(" ",sort keys %args);
	return $default{$min_suffix} ||= shift->from_string(_default_data(),
	    min_suffix => $min_suffix);
    }
}

sub from_string {
    my $class = shift;
    my $data  = shift;
    open( my $fh,'<', \$data );
    return $class->from_file($fh,@_);
}

sub from_file {
    my ($class,$file,%args) = @_;
    my $min_suffix = delete $args{min_suffix};
    $min_suffix = 1 if ! defined $min_suffix;
    %args and die "unknown args: ".join(" ",sort keys %args);

    my $fh;
    if ( ref($file)) {
	$fh = $file
    } elsif ( ! open($fh,'<',$file)) {
	die "failed to open $file: $!";
    }
    my %tree;
    local $/ = "\n";
    while ( my $line = <$fh>) {
	$line =~s{//.*}{};
	$line =~s{\s+$}{};
	$line eq '' and next;
	my $p = \%tree;
	$line = idn_to_ascii($line) if $line !~m{\A[\x00-\x7f]*\Z};
	my $not = $line =~s{^!}{};
	my @path = split(m{\.},$line);
	for(reverse @path) {
	    $p = $p->{$_} ||= {}
	}
	$p->{'\0'} = $not ? -1:1;
    }
    return bless { 
	tree => \%tree, 
	min_suffix => $min_suffix 
    },$class;
}


sub public_suffix {
    my ($self,$name,$add) = @_;
    my $want; # [a]rray, [s]tring, [u]nicode-string
    if ( ref($name)) {
	$want = 'a';
	$name = [ @$name ]; # don't change input
    } else {
	return if ! defined $name;
	if ( $name !~m{\A[\x00-\x7f]*\Z} ) {
	    $name = idn_to_ascii($name);
	    $want = 'u';
	} else {
	    $want = 's';
	}
	$name = lc($name);
	$name =~s{\.$}{};
	$name = [ $name =~m{([^.]+)}g ];
    }
    @$name or return;
    $_ = lc($_) for(@$name);

    my (%wild,%host,%xcept,@stack,$choices);
    my $p = $self->{tree};
    for( my $i=0; $i<@$name; $i++ ) {
	$choices = [];
	if ( my $px = $p->{ $name->[$#$name-$i] } ) {
	    # name match, continue with next path element
	    push @$choices,$px;
	    if ( my $end = $px->{'\0'} ) {
		( $end>0 ? \%host : \%xcept )->{$i+1} = $end;
	    }
	}
	if ( my $px = $p->{'*'} ) {
	    # wildcard match, continue with next path element
	    push @$choices,$px;
	    if ( my $end = $px->{'\0'} ) {
		( $end>0 ? \%wild : \%xcept )->{$i+1} = $end;
	    }
	}


	next_choice:
	if ( @$choices ) {
	    $p = shift(@$choices);
	    push @stack, [ $choices, $i ] if @$choices;
	    next; # go deeper
	}

	# backtrack
	@stack or last;
	($choices,$i) = @{ pop(@stack) };
	goto next_choice;
    }

    #warn Dumper([\%wild,\%host,\%xcept]); use Data::Dumper;


    # remove all exceptions from wildcards
    delete @wild{ keys %xcept } if %xcept;
    # get longest match
    my ($len) = sort { $b <=> $a } (
	keys(%wild), keys(%host), map { $_-1 } keys(%xcept));
    # if we have no matches use a minimum of min_suffix
    $len = $self->{min_suffix} if ! defined $len;
    $len += $add if $add;
    my $suffix;
    if ( $len < @$name ) {
	$suffix = [ splice( @$name, -$len, $len ) ];
    } elsif ( $len > 0 ) {
	$suffix = $name;
	$name = []
    } else {
	$suffix = []
    }

    if ( $want ne 'a' ) {
	$suffix = join('.',@$suffix);
	$name = join('.',@$name);
	if ( $want eq 'u' ) {
	    $suffix = idn_to_unicode($suffix);
	    $name   = idn_to_unicode($name);
	}
    }

    return wantarray ? ($name,$suffix):$suffix;
}


{
    my $data;
    sub _default_data {
	if ( ! defined $data ) {
	    $data = _builtin_data();
	    $data =~s{^// ===END ICANN DOMAINS.*}{}ms
		or die "cannot find END ICANN DOMAINS";
	}
	return $data;
    }
}

sub update_self_from_url {
    my $url = shift || URL();
    my $dst = __FILE__;
    -w $dst or die "cannot write $dst";
    open( my $fh,'<',$dst ) or die "open $dst: $!";
    my $code = '';
    local $/ = "\n";
    while (<$fh>) {
	$code .= $_;
	m{<<\'END_BUILTIN_DATA\'} and last;
    }
    my $tail;
    while (<$fh>) {
	m{\AEND_BUILTIN_DATA\r?\n} or next;
	$tail = $_;
	last;
    }
    $tail .= do { local $/; <$fh> };
    close($fh);

    require LWP::UserAgent;
    my $resp = LWP::UserAgent->new->get($url)
	or die "no response from $url";
    die "no success url=$url code=".$resp->code." ".$resp->message 
	if ! $resp->is_success;
    my $content = $resp->decoded_content;
    while ( $content =~m{(.*\n)}g ) {
	my $line = $1;
	if ( $line =~m{\S} && $line !~m{\A\s*//} ) {
	    $line =~s{//.*}{};
	    $line =~s{\s+$}{};
	    $line eq '' and next;
	    if ( $line !~m{\A[\x00-\x7f]+\Z} ) {
		$line = idn_to_ascii($line);
	    }
	    $code .= "$line\n";
	} else {
	    $code .= "$line";
	}
    }

    open( $fh,'>:utf8',$dst ) or die "open $dst: $!";
    print $fh $code.$tail;
}

sub _builtin_data { return <<'END_BUILTIN_DATA' }
// This Source Code Form is subject to the terms of the Mozilla Public
// License, v. 2.0. If a copy of the MPL was not distributed with this
// file, You can obtain one at https://mozilla.org/MPL/2.0/.

// Please pull this list from, and only from https://publicsuffix.org/list/public_suffix_list.dat,
// rather than any other VCS sites. Pulling from any other URL is not guaranteed to be supported.

// Instructions on pulling and using this list can be found at https://publicsuffix.org/list/.

// ===BEGIN ICANN DOMAINS===

// ac : https://en.wikipedia.org/wiki/.ac
ac
com.ac
edu.ac
gov.ac
net.ac
mil.ac
org.ac

// ad : https://en.wikipedia.org/wiki/.ad
ad
nom.ad

// ae : https://en.wikipedia.org/wiki/.ae
// see also: "Domain Name Eligibility Policy" at http://www.aeda.ae/eng/aepolicy.php
ae
co.ae
net.ae
org.ae
sch.ae
ac.ae
gov.ae
mil.ae

// aero : see https://www.information.aero/index.php?id=66
aero
accident-investigation.aero
accident-prevention.aero
aerobatic.aero
aeroclub.aero
aerodrome.aero
agents.aero
aircraft.aero
airline.aero
airport.aero
air-surveillance.aero
airtraffic.aero
air-traffic-control.aero
ambulance.aero
amusement.aero
association.aero
author.aero
ballooning.aero
broker.aero
caa.aero
cargo.aero
catering.aero
certification.aero
championship.aero
charter.aero
civilaviation.aero
club.aero
conference.aero
consultant.aero
consulting.aero
control.aero
council.aero
crew.aero
design.aero
dgca.aero
educator.aero
emergency.aero
engine.aero
engineer.aero
entertainment.aero
equipment.aero
exchange.aero
express.aero
federation.aero
flight.aero
fuel.aero
gliding.aero
government.aero
groundhandling.aero
group.aero
hanggliding.aero
homebuilt.aero
insurance.aero
journal.aero
journalist.aero
leasing.aero
logistics.aero
magazine.aero
maintenance.aero
media.aero
microlight.aero
modelling.aero
navigation.aero
parachuting.aero
paragliding.aero
passenger-association.aero
pilot.aero
press.aero
production.aero
recreation.aero
repbody.aero
res.aero
research.aero
rotorcraft.aero
safety.aero
scientist.aero
services.aero
show.aero
skydiving.aero
software.aero
student.aero
trader.aero
trading.aero
trainer.aero
union.aero
workinggroup.aero
works.aero

// af : http://www.nic.af/help.jsp
af
gov.af
com.af
org.af
net.af
edu.af

// ag : http://www.nic.ag/prices.htm
ag
com.ag
org.ag
net.ag
co.ag
nom.ag

// ai : http://nic.com.ai/
ai
off.ai
com.ai
net.ai
org.ai

// al : http://www.ert.gov.al/ert_alb/faq_det.html?Id=31
al
com.al
edu.al
gov.al
mil.al
net.al
org.al

// am : https://www.amnic.net/policy/en/Policy_EN.pdf
am
co.am
com.am
commune.am
net.am
org.am

// ao : https://en.wikipedia.org/wiki/.ao
// http://www.dns.ao/REGISTR.DOC
ao
ed.ao
gv.ao
og.ao
co.ao
pb.ao
it.ao

// aq : https://en.wikipedia.org/wiki/.aq
aq

// ar : https://nic.ar/nic-argentina/normativa-vigente
ar
com.ar
edu.ar
gob.ar
gov.ar
int.ar
mil.ar
musica.ar
net.ar
org.ar
tur.ar

// arpa : https://en.wikipedia.org/wiki/.arpa
// Confirmed by registry <iana-questions@icann.org> 2008-06-18
arpa
e164.arpa
in-addr.arpa
ip6.arpa
iris.arpa
uri.arpa
urn.arpa

// as : https://en.wikipedia.org/wiki/.as
as
gov.as

// asia : https://en.wikipedia.org/wiki/.asia
asia

// at : https://en.wikipedia.org/wiki/.at
// Confirmed by registry <it@nic.at> 2008-06-17
at
ac.at
co.at
gv.at
or.at
sth.ac.at

// au : https://en.wikipedia.org/wiki/.au
// http://www.auda.org.au/
au
// 2LDs
com.au
net.au
org.au
edu.au
gov.au
asn.au
id.au
// Historic 2LDs (closed to new registration, but sites still exist)
info.au
conf.au
oz.au
// CGDNs - http://www.cgdn.org.au/
act.au
nsw.au
nt.au
qld.au
sa.au
tas.au
vic.au
wa.au
// 3LDs
act.edu.au
catholic.edu.au
// eq.edu.au - Removed at the request of the Queensland Department of Education
nsw.edu.au
nt.edu.au
qld.edu.au
sa.edu.au
tas.edu.au
vic.edu.au
wa.edu.au
// act.gov.au  Bug 984824 - Removed at request of Greg Tankard
// nsw.gov.au  Bug 547985 - Removed at request of <Shae.Donelan@services.nsw.gov.au>
// nt.gov.au  Bug 940478 - Removed at request of Greg Connors <Greg.Connors@nt.gov.au>
qld.gov.au
sa.gov.au
tas.gov.au
vic.gov.au
wa.gov.au
// 4LDs
// education.tas.edu.au - Removed at the request of the Department of Education Tasmania
schools.nsw.edu.au

// aw : https://en.wikipedia.org/wiki/.aw
aw
com.aw

// ax : https://en.wikipedia.org/wiki/.ax
ax

// az : https://en.wikipedia.org/wiki/.az
az
com.az
net.az
int.az
gov.az
org.az
edu.az
info.az
pp.az
mil.az
name.az
pro.az
biz.az

// ba : http://nic.ba/users_data/files/pravilnik_o_registraciji.pdf
ba
com.ba
edu.ba
gov.ba
mil.ba
net.ba
org.ba

// bb : https://en.wikipedia.org/wiki/.bb
bb
biz.bb
co.bb
com.bb
edu.bb
gov.bb
info.bb
net.bb
org.bb
store.bb
tv.bb

// bd : https://en.wikipedia.org/wiki/.bd
*.bd

// be : https://en.wikipedia.org/wiki/.be
// Confirmed by registry <tech@dns.be> 2008-06-08
be
ac.be

// bf : https://en.wikipedia.org/wiki/.bf
bf
gov.bf

// bg : https://en.wikipedia.org/wiki/.bg
// https://www.register.bg/user/static/rules/en/index.html
bg
a.bg
b.bg
c.bg
d.bg
e.bg
f.bg
g.bg
h.bg
i.bg
j.bg
k.bg
l.bg
m.bg
n.bg
o.bg
p.bg
q.bg
r.bg
s.bg
t.bg
u.bg
v.bg
w.bg
x.bg
y.bg
z.bg
0.bg
1.bg
2.bg
3.bg
4.bg
5.bg
6.bg
7.bg
8.bg
9.bg

// bh : https://en.wikipedia.org/wiki/.bh
bh
com.bh
edu.bh
net.bh
org.bh
gov.bh

// bi : https://en.wikipedia.org/wiki/.bi
// http://whois.nic.bi/
bi
co.bi
com.bi
edu.bi
or.bi
org.bi

// biz : https://en.wikipedia.org/wiki/.biz
biz

// bj : https://en.wikipedia.org/wiki/.bj
bj
asso.bj
barreau.bj
gouv.bj

// bm : http://www.bermudanic.bm/dnr-text.txt
bm
com.bm
edu.bm
gov.bm
net.bm
org.bm

// bn : http://www.bnnic.bn/faqs
bn
com.bn
edu.bn
gov.bn
net.bn
org.bn

// bo : https://nic.bo/delegacion2015.php#h-1.10
bo
com.bo
edu.bo
gob.bo
int.bo
org.bo
net.bo
mil.bo
tv.bo
web.bo
// Social Domains
academia.bo
agro.bo
arte.bo
blog.bo
bolivia.bo
ciencia.bo
cooperativa.bo
democracia.bo
deporte.bo
ecologia.bo
economia.bo
empresa.bo
indigena.bo
industria.bo
info.bo
medicina.bo
movimiento.bo
musica.bo
natural.bo
nombre.bo
noticias.bo
patria.bo
politica.bo
profesional.bo
plurinacional.bo
pueblo.bo
revista.bo
salud.bo
tecnologia.bo
tksat.bo
transporte.bo
wiki.bo

// br : http://registro.br/dominio/categoria.html
// Submitted by registry <fneves@registro.br>
br
9guacu.br
abc.br
adm.br
adv.br
agr.br
aju.br
am.br
anani.br
aparecida.br
app.br
arq.br
art.br
ato.br
b.br
barueri.br
belem.br
bhz.br
bib.br
bio.br
blog.br
bmd.br
boavista.br
bsb.br
campinagrande.br
campinas.br
caxias.br
cim.br
cng.br
cnt.br
com.br
contagem.br
coop.br
coz.br
cri.br
cuiaba.br
curitiba.br
def.br
des.br
det.br
dev.br
ecn.br
eco.br
edu.br
emp.br
enf.br
eng.br
esp.br
etc.br
eti.br
far.br
feira.br
flog.br
floripa.br
fm.br
fnd.br
fortal.br
fot.br
foz.br
fst.br
g12.br
geo.br
ggf.br
goiania.br
gov.br
// gov.br 26 states + df https://en.wikipedia.org/wiki/States_of_Brazil
ac.gov.br
al.gov.br
am.gov.br
ap.gov.br
ba.gov.br
ce.gov.br
df.gov.br
es.gov.br
go.gov.br
ma.gov.br
mg.gov.br
ms.gov.br
mt.gov.br
pa.gov.br
pb.gov.br
pe.gov.br
pi.gov.br
pr.gov.br
rj.gov.br
rn.gov.br
ro.gov.br
rr.gov.br
rs.gov.br
sc.gov.br
se.gov.br
sp.gov.br
to.gov.br
gru.br
imb.br
ind.br
inf.br
jab.br
jampa.br
jdf.br
joinville.br
jor.br
jus.br
leg.br
lel.br
log.br
londrina.br
macapa.br
maceio.br
manaus.br
maringa.br
mat.br
med.br
mil.br
morena.br
mp.br
mus.br
natal.br
net.br
niteroi.br
*.nom.br
not.br
ntr.br
odo.br
ong.br
org.br
osasco.br
palmas.br
poa.br
ppg.br
pro.br
psc.br
psi.br
pvh.br
qsl.br
radio.br
rec.br
recife.br
rep.br
ribeirao.br
rio.br
riobranco.br
riopreto.br
salvador.br
sampa.br
santamaria.br
santoandre.br
saobernardo.br
saogonca.br
seg.br
sjc.br
slg.br
slz.br
sorocaba.br
srv.br
taxi.br
tc.br
tec.br
teo.br
the.br
tmp.br
trd.br
tur.br
tv.br
udi.br
vet.br
vix.br
vlog.br
wiki.br
zlg.br

// bs : http://www.nic.bs/rules.html
bs
com.bs
net.bs
org.bs
edu.bs
gov.bs

// bt : https://en.wikipedia.org/wiki/.bt
bt
com.bt
edu.bt
gov.bt
net.bt
org.bt

// bv : No registrations at this time.
// Submitted by registry <jarle@uninett.no>
bv

// bw : https://en.wikipedia.org/wiki/.bw
// http://www.gobin.info/domainname/bw.doc
// list of other 2nd level tlds ?
bw
co.bw
org.bw

// by : https://en.wikipedia.org/wiki/.by
// http://tld.by/rules_2006_en.html
// list of other 2nd level tlds ?
by
gov.by
mil.by
// Official information does not indicate that com.by is a reserved
// second-level domain, but it's being used as one (see www.google.com.by and
// www.yahoo.com.by, for example), so we list it here for safety's sake.
com.by

// http://hoster.by/
of.by

// bz : https://en.wikipedia.org/wiki/.bz
// http://www.belizenic.bz/
bz
com.bz
net.bz
org.bz
edu.bz
gov.bz

// ca : https://en.wikipedia.org/wiki/.ca
ca
// ca geographical names
ab.ca
bc.ca
mb.ca
nb.ca
nf.ca
nl.ca
ns.ca
nt.ca
nu.ca
on.ca
pe.ca
qc.ca
sk.ca
yk.ca
// gc.ca: https://en.wikipedia.org/wiki/.gc.ca
// see also: http://registry.gc.ca/en/SubdomainFAQ
gc.ca

// cat : https://en.wikipedia.org/wiki/.cat
cat

// cc : https://en.wikipedia.org/wiki/.cc
cc

// cd : https://en.wikipedia.org/wiki/.cd
// see also: https://www.nic.cd/domain/insertDomain_2.jsp?act=1
cd
gov.cd

// cf : https://en.wikipedia.org/wiki/.cf
cf

// cg : https://en.wikipedia.org/wiki/.cg
cg

// ch : https://en.wikipedia.org/wiki/.ch
ch

// ci : https://en.wikipedia.org/wiki/.ci
// http://www.nic.ci/index.php?page=charte
ci
org.ci
or.ci
com.ci
co.ci
edu.ci
ed.ci
ac.ci
net.ci
go.ci
asso.ci
xn--aroport-bya.ci
int.ci
presse.ci
md.ci
gouv.ci

// ck : https://en.wikipedia.org/wiki/.ck
*.ck
!www.ck

// cl : https://www.nic.cl
// Confirmed by .CL registry <hsalgado@nic.cl>
cl
co.cl
gob.cl
gov.cl
mil.cl

// cm : https://en.wikipedia.org/wiki/.cm plus bug 981927
cm
co.cm
com.cm
gov.cm
net.cm

// cn : https://en.wikipedia.org/wiki/.cn
// Submitted by registry <tanyaling@cnnic.cn>
cn
ac.cn
com.cn
edu.cn
gov.cn
net.cn
org.cn
mil.cn
xn--55qx5d.cn
xn--io0a7i.cn
xn--od0alg.cn
// cn geographic names
ah.cn
bj.cn
cq.cn
fj.cn
gd.cn
gs.cn
gz.cn
gx.cn
ha.cn
hb.cn
he.cn
hi.cn
hl.cn
hn.cn
jl.cn
js.cn
jx.cn
ln.cn
nm.cn
nx.cn
qh.cn
sc.cn
sd.cn
sh.cn
sn.cn
sx.cn
tj.cn
xj.cn
xz.cn
yn.cn
zj.cn
hk.cn
mo.cn
tw.cn

// co : https://en.wikipedia.org/wiki/.co
// Submitted by registry <tecnico@uniandes.edu.co>
co
arts.co
com.co
edu.co
firm.co
gov.co
info.co
int.co
mil.co
net.co
nom.co
org.co
rec.co
web.co

// com : https://en.wikipedia.org/wiki/.com
com

// coop : https://en.wikipedia.org/wiki/.coop
coop

// cr : http://www.nic.cr/niccr_publico/showRegistroDominiosScreen.do
cr
ac.cr
co.cr
ed.cr
fi.cr
go.cr
or.cr
sa.cr

// cu : https://en.wikipedia.org/wiki/.cu
cu
com.cu
edu.cu
org.cu
net.cu
gov.cu
inf.cu

// cv : https://en.wikipedia.org/wiki/.cv
cv

// cw : http://www.una.cw/cw_registry/
// Confirmed by registry <registry@una.net> 2013-03-26
cw
com.cw
edu.cw
net.cw
org.cw

// cx : https://en.wikipedia.org/wiki/.cx
// list of other 2nd level tlds ?
cx
gov.cx

// cy : http://www.nic.cy/
// Submitted by registry Panayiotou Fotia <cydns@ucy.ac.cy>
cy
ac.cy
biz.cy
com.cy
ekloges.cy
gov.cy
ltd.cy
name.cy
net.cy
org.cy
parliament.cy
press.cy
pro.cy
tm.cy

// cz : https://en.wikipedia.org/wiki/.cz
cz

// de : https://en.wikipedia.org/wiki/.de
// Confirmed by registry <ops@denic.de> (with technical
// reservations) 2008-07-01
de

// dj : https://en.wikipedia.org/wiki/.dj
dj

// dk : https://en.wikipedia.org/wiki/.dk
// Confirmed by registry <robert@dk-hostmaster.dk> 2008-06-17
dk

// dm : https://en.wikipedia.org/wiki/.dm
dm
com.dm
net.dm
org.dm
edu.dm
gov.dm

// do : https://en.wikipedia.org/wiki/.do
do
art.do
com.do
edu.do
gob.do
gov.do
mil.do
net.do
org.do
sld.do
web.do

// dz : http://www.nic.dz/images/pdf_nic/charte.pdf
dz
art.dz
asso.dz
com.dz
edu.dz
gov.dz
org.dz
net.dz
pol.dz
soc.dz
tm.dz

// ec : http://www.nic.ec/reg/paso1.asp
// Submitted by registry <vabboud@nic.ec>
ec
com.ec
info.ec
net.ec
fin.ec
k12.ec
med.ec
pro.ec
org.ec
edu.ec
gov.ec
gob.ec
mil.ec

// edu : https://en.wikipedia.org/wiki/.edu
edu

// ee : http://www.eenet.ee/EENet/dom_reeglid.html#lisa_B
ee
edu.ee
gov.ee
riik.ee
lib.ee
med.ee
com.ee
pri.ee
aip.ee
org.ee
fie.ee

// eg : https://en.wikipedia.org/wiki/.eg
eg
com.eg
edu.eg
eun.eg
gov.eg
mil.eg
name.eg
net.eg
org.eg
sci.eg

// er : https://en.wikipedia.org/wiki/.er
*.er

// es : https://www.nic.es/site_ingles/ingles/dominios/index.html
es
com.es
nom.es
org.es
gob.es
edu.es

// et : https://en.wikipedia.org/wiki/.et
et
com.et
gov.et
org.et
edu.et
biz.et
name.et
info.et
net.et

// eu : https://en.wikipedia.org/wiki/.eu
eu

// fi : https://en.wikipedia.org/wiki/.fi
fi
// aland.fi : https://en.wikipedia.org/wiki/.ax
// This domain is being phased out in favor of .ax. As there are still many
// domains under aland.fi, we still keep it on the list until aland.fi is
// completely removed.
// TODO: Check for updates (expected to be phased out around Q1/2009)
aland.fi

// fj : http://domains.fj/
// Submitted by registry <garth.miller@cocca.org.nz> 2020-02-11
fj
ac.fj
biz.fj
com.fj
gov.fj
info.fj
mil.fj
name.fj
net.fj
org.fj
pro.fj

// fk : https://en.wikipedia.org/wiki/.fk
*.fk

// fm : https://en.wikipedia.org/wiki/.fm
com.fm
edu.fm
net.fm
org.fm
fm

// fo : https://en.wikipedia.org/wiki/.fo
fo

// fr : http://www.afnic.fr/
// domaines descriptifs : https://www.afnic.fr/medias/documents/Cadre_legal/Afnic_Naming_Policy_12122016_VEN.pdf
fr
asso.fr
com.fr
gouv.fr
nom.fr
prd.fr
tm.fr
// domaines sectoriels : https://www.afnic.fr/en/products-and-services/the-fr-tld/sector-based-fr-domains-4.html
aeroport.fr
avocat.fr
avoues.fr
cci.fr
chambagri.fr
chirurgiens-dentistes.fr
experts-comptables.fr
geometre-expert.fr
greta.fr
huissier-justice.fr
medecin.fr
notaires.fr
pharmacien.fr
port.fr
veterinaire.fr

// ga : https://en.wikipedia.org/wiki/.ga
ga

// gb : This registry is effectively dormant
// Submitted by registry <Damien.Shaw@ja.net>
gb

// gd : https://en.wikipedia.org/wiki/.gd
edu.gd
gov.gd
gd

// ge : http://www.nic.net.ge/policy_en.pdf
ge
com.ge
edu.ge
gov.ge
org.ge
mil.ge
net.ge
pvt.ge

// gf : https://en.wikipedia.org/wiki/.gf
gf

// gg : http://www.channelisles.net/register-domains/
// Confirmed by registry <nigel@channelisles.net> 2013-11-28
gg
co.gg
net.gg
org.gg

// gh : https://en.wikipedia.org/wiki/.gh
// see also: http://www.nic.gh/reg_now.php
// Although domains directly at second level are not possible at the moment,
// they have been possible for some time and may come back.
gh
com.gh
edu.gh
gov.gh
org.gh
mil.gh

// gi : http://www.nic.gi/rules.html
gi
com.gi
ltd.gi
gov.gi
mod.gi
edu.gi
org.gi

// gl : https://en.wikipedia.org/wiki/.gl
// http://nic.gl
gl
co.gl
com.gl
edu.gl
net.gl
org.gl

// gm : http://www.nic.gm/htmlpages%5Cgm-policy.htm
gm

// gn : http://psg.com/dns/gn/gn.txt
// Submitted by registry <randy@psg.com>
gn
ac.gn
com.gn
edu.gn
gov.gn
org.gn
net.gn

// gov : https://en.wikipedia.org/wiki/.gov
gov

// gp : http://www.nic.gp/index.php?lang=en
gp
com.gp
net.gp
mobi.gp
edu.gp
org.gp
asso.gp

// gq : https://en.wikipedia.org/wiki/.gq
gq

// gr : https://grweb.ics.forth.gr/english/1617-B-2005.html
// Submitted by registry <segred@ics.forth.gr>
gr
com.gr
edu.gr
net.gr
org.gr
gov.gr

// gs : https://en.wikipedia.org/wiki/.gs
gs

// gt : https://www.gt/sitio/registration_policy.php?lang=en
gt
com.gt
edu.gt
gob.gt
ind.gt
mil.gt
net.gt
org.gt

// gu : http://gadao.gov.gu/register.html
// University of Guam : https://www.uog.edu
// Submitted by uognoc@triton.uog.edu
gu
com.gu
edu.gu
gov.gu
guam.gu
info.gu
net.gu
org.gu
web.gu

// gw : https://en.wikipedia.org/wiki/.gw
gw

// gy : https://en.wikipedia.org/wiki/.gy
// http://registry.gy/
gy
co.gy
com.gy
edu.gy
gov.gy
net.gy
org.gy

// hk : https://www.hkirc.hk
// Submitted by registry <hk.tech@hkirc.hk>
hk
com.hk
edu.hk
gov.hk
idv.hk
net.hk
org.hk
xn--55qx5d.hk
xn--wcvs22d.hk
xn--lcvr32d.hk
xn--mxtq1m.hk
xn--gmqw5a.hk
xn--ciqpn.hk
xn--gmq050i.hk
xn--zf0avx.hk
xn--io0a7i.hk
xn--mk0axi.hk
xn--od0alg.hk
xn--od0aq3b.hk
xn--tn0ag.hk
xn--uc0atv.hk
xn--uc0ay4a.hk

// hm : https://en.wikipedia.org/wiki/.hm
hm

// hn : http://www.nic.hn/politicas/ps02,,05.html
hn
com.hn
edu.hn
org.hn
net.hn
mil.hn
gob.hn

// hr : http://www.dns.hr/documents/pdf/HRTLD-regulations.pdf
hr
iz.hr
from.hr
name.hr
com.hr

// ht : http://www.nic.ht/info/charte.cfm
ht
com.ht
shop.ht
firm.ht
info.ht
adult.ht
net.ht
pro.ht
org.ht
med.ht
art.ht
coop.ht
pol.ht
asso.ht
edu.ht
rel.ht
gouv.ht
perso.ht

// hu : http://www.domain.hu/domain/English/sld.html
// Confirmed by registry <pasztor@iszt.hu> 2008-06-12
hu
co.hu
info.hu
org.hu
priv.hu
sport.hu
tm.hu
2000.hu
agrar.hu
bolt.hu
casino.hu
city.hu
erotica.hu
erotika.hu
film.hu
forum.hu
games.hu
hotel.hu
ingatlan.hu
jogasz.hu
konyvelo.hu
lakas.hu
media.hu
news.hu
reklam.hu
sex.hu
shop.hu
suli.hu
szex.hu
tozsde.hu
utazas.hu
video.hu

// id : https://pandi.id/en/domain/registration-requirements/
id
ac.id
biz.id
co.id
desa.id
go.id
mil.id
my.id
net.id
or.id
ponpes.id
sch.id
web.id

// ie : https://en.wikipedia.org/wiki/.ie
ie
gov.ie

// il : http://www.isoc.org.il/domains/
il
ac.il
co.il
gov.il
idf.il
k12.il
muni.il
net.il
org.il

// im : https://www.nic.im/
// Submitted by registry <info@nic.im>
im
ac.im
co.im
com.im
ltd.co.im
net.im
org.im
plc.co.im
tt.im
tv.im

// in : https://en.wikipedia.org/wiki/.in
// see also: https://registry.in/Policies
// Please note, that nic.in is not an official eTLD, but used by most
// government institutions.
in
co.in
firm.in
net.in
org.in
gen.in
ind.in
nic.in
ac.in
edu.in
res.in
gov.in
mil.in

// info : https://en.wikipedia.org/wiki/.info
info

// int : https://en.wikipedia.org/wiki/.int
// Confirmed by registry <iana-questions@icann.org> 2008-06-18
int
eu.int

// io : http://www.nic.io/rules.html
// list of other 2nd level tlds ?
io
com.io

// iq : http://www.cmc.iq/english/iq/iqregister1.htm
iq
gov.iq
edu.iq
mil.iq
com.iq
org.iq
net.iq

// ir : http://www.nic.ir/Terms_and_Conditions_ir,_Appendix_1_Domain_Rules
// Also see http://www.nic.ir/Internationalized_Domain_Names
// Two <iran>.ir entries added at request of <tech-team@nic.ir>, 2010-04-16
ir
ac.ir
co.ir
gov.ir
id.ir
net.ir
org.ir
sch.ir
// xn--mgba3a4f16a.ir (<iran>.ir, Persian YEH)
xn--mgba3a4f16a.ir
// xn--mgba3a4fra.ir (<iran>.ir, Arabic YEH)
xn--mgba3a4fra.ir

// is : http://www.isnic.is/domain/rules.php
// Confirmed by registry <marius@isgate.is> 2008-12-06
is
net.is
com.is
edu.is
gov.is
org.is
int.is

// it : https://en.wikipedia.org/wiki/.it
it
gov.it
edu.it
// Reserved geo-names (regions and provinces):
// https://www.nic.it/sites/default/files/archivio/docs/Regulation_assignation_v7.1.pdf
// Regions
abr.it
abruzzo.it
aosta-valley.it
aostavalley.it
bas.it
basilicata.it
cal.it
calabria.it
cam.it
campania.it
emilia-romagna.it
emiliaromagna.it
emr.it
friuli-v-giulia.it
friuli-ve-giulia.it
friuli-vegiulia.it
friuli-venezia-giulia.it
friuli-veneziagiulia.it
friuli-vgiulia.it
friuliv-giulia.it
friulive-giulia.it
friulivegiulia.it
friulivenezia-giulia.it
friuliveneziagiulia.it
friulivgiulia.it
fvg.it
laz.it
lazio.it
lig.it
liguria.it
lom.it
lombardia.it
lombardy.it
lucania.it
mar.it
marche.it
mol.it
molise.it
piedmont.it
piemonte.it
pmn.it
pug.it
puglia.it
sar.it
sardegna.it
sardinia.it
sic.it
sicilia.it
sicily.it
taa.it
tos.it
toscana.it
trentin-sud-tirol.it
xn--trentin-sd-tirol-rzb.it
trentin-sudtirol.it
xn--trentin-sdtirol-7vb.it
trentin-sued-tirol.it
trentin-suedtirol.it
trentino-a-adige.it
trentino-aadige.it
trentino-alto-adige.it
trentino-altoadige.it
trentino-s-tirol.it
trentino-stirol.it
trentino-sud-tirol.it
xn--trentino-sd-tirol-c3b.it
trentino-sudtirol.it
xn--trentino-sdtirol-szb.it
trentino-sued-tirol.it
trentino-suedtirol.it
trentino.it
trentinoa-adige.it
trentinoaadige.it
trentinoalto-adige.it
trentinoaltoadige.it
trentinos-tirol.it
trentinostirol.it
trentinosud-tirol.it
xn--trentinosd-tirol-rzb.it
trentinosudtirol.it
xn--trentinosdtirol-7vb.it
trentinosued-tirol.it
trentinosuedtirol.it
trentinsud-tirol.it
xn--trentinsd-tirol-6vb.it
trentinsudtirol.it
xn--trentinsdtirol-nsb.it
trentinsued-tirol.it
trentinsuedtirol.it
tuscany.it
umb.it
umbria.it
val-d-aosta.it
val-daosta.it
vald-aosta.it
valdaosta.it
valle-aosta.it
valle-d-aosta.it
valle-daosta.it
valleaosta.it
valled-aosta.it
valledaosta.it
vallee-aoste.it
xn--valle-aoste-ebb.it
vallee-d-aoste.it
xn--valle-d-aoste-ehb.it
valleeaoste.it
xn--valleaoste-e7a.it
valleedaoste.it
xn--valledaoste-ebb.it
vao.it
vda.it
ven.it
veneto.it
// Provinces
ag.it
agrigento.it
al.it
alessandria.it
alto-adige.it
altoadige.it
an.it
ancona.it
andria-barletta-trani.it
andria-trani-barletta.it
andriabarlettatrani.it
andriatranibarletta.it
ao.it
aosta.it
aoste.it
ap.it
aq.it
aquila.it
ar.it
arezzo.it
ascoli-piceno.it
ascolipiceno.it
asti.it
at.it
av.it
avellino.it
ba.it
balsan-sudtirol.it
xn--balsan-sdtirol-nsb.it
balsan-suedtirol.it
balsan.it
bari.it
barletta-trani-andria.it
barlettatraniandria.it
belluno.it
benevento.it
bergamo.it
bg.it
bi.it
biella.it
bl.it
bn.it
bo.it
bologna.it
bolzano-altoadige.it
bolzano.it
bozen-sudtirol.it
xn--bozen-sdtirol-2ob.it
bozen-suedtirol.it
bozen.it
br.it
brescia.it
brindisi.it
bs.it
bt.it
bulsan-sudtirol.it
xn--bulsan-sdtirol-nsb.it
bulsan-suedtirol.it
bulsan.it
bz.it
ca.it
cagliari.it
caltanissetta.it
campidano-medio.it
campidanomedio.it
campobasso.it
carbonia-iglesias.it
carboniaiglesias.it
carrara-massa.it
carraramassa.it
caserta.it
catania.it
catanzaro.it
cb.it
ce.it
cesena-forli.it
xn--cesena-forl-mcb.it
cesenaforli.it
xn--cesenaforl-i8a.it
ch.it
chieti.it
ci.it
cl.it
cn.it
co.it
como.it
cosenza.it
cr.it
cremona.it
crotone.it
cs.it
ct.it
cuneo.it
cz.it
dell-ogliastra.it
dellogliastra.it
en.it
enna.it
fc.it
fe.it
fermo.it
ferrara.it
fg.it
fi.it
firenze.it
florence.it
fm.it
foggia.it
forli-cesena.it
xn--forl-cesena-fcb.it
forlicesena.it
xn--forlcesena-c8a.it
fr.it
frosinone.it
ge.it
genoa.it
genova.it
go.it
gorizia.it
gr.it
grosseto.it
iglesias-carbonia.it
iglesiascarbonia.it
im.it
imperia.it
is.it
isernia.it
kr.it
la-spezia.it
laquila.it
laspezia.it
latina.it
lc.it
le.it
lecce.it
lecco.it
li.it
livorno.it
lo.it
lodi.it
lt.it
lu.it
lucca.it
macerata.it
mantova.it
massa-carrara.it
massacarrara.it
matera.it
mb.it
mc.it
me.it
medio-campidano.it
mediocampidano.it
messina.it
mi.it
milan.it
milano.it
mn.it
mo.it
modena.it
monza-brianza.it
monza-e-della-brianza.it
monza.it
monzabrianza.it
monzaebrianza.it
monzaedellabrianza.it
ms.it
mt.it
na.it
naples.it
napoli.it
no.it
novara.it
nu.it
nuoro.it
og.it
ogliastra.it
olbia-tempio.it
olbiatempio.it
or.it
oristano.it
ot.it
pa.it
padova.it
padua.it
palermo.it
parma.it
pavia.it
pc.it
pd.it
pe.it
perugia.it
pesaro-urbino.it
pesarourbino.it
pescara.it
pg.it
pi.it
piacenza.it
pisa.it
pistoia.it
pn.it
po.it
pordenone.it
potenza.it
pr.it
prato.it
pt.it
pu.it
pv.it
pz.it
ra.it
ragusa.it
ravenna.it
rc.it
re.it
reggio-calabria.it
reggio-emilia.it
reggiocalabria.it
reggioemilia.it
rg.it
ri.it
rieti.it
rimini.it
rm.it
rn.it
ro.it
roma.it
rome.it
rovigo.it
sa.it
salerno.it
sassari.it
savona.it
si.it
siena.it
siracusa.it
so.it
sondrio.it
sp.it
sr.it
ss.it
suedtirol.it
xn--sdtirol-n2a.it
sv.it
ta.it
taranto.it
te.it
tempio-olbia.it
tempioolbia.it
teramo.it
terni.it
tn.it
to.it
torino.it
tp.it
tr.it
trani-andria-barletta.it
trani-barletta-andria.it
traniandriabarletta.it
tranibarlettaandria.it
trapani.it
trento.it
treviso.it
trieste.it
ts.it
turin.it
tv.it
ud.it
udine.it
urbino-pesaro.it
urbinopesaro.it
va.it
varese.it
vb.it
vc.it
ve.it
venezia.it
venice.it
verbania.it
vercelli.it
verona.it
vi.it
vibo-valentia.it
vibovalentia.it
vicenza.it
viterbo.it
vr.it
vs.it
vt.it
vv.it

// je : http://www.channelisles.net/register-domains/
// Confirmed by registry <nigel@channelisles.net> 2013-11-28
je
co.je
net.je
org.je

// jm : http://www.com.jm/register.html
*.jm

// jo : http://www.dns.jo/Registration_policy.aspx
jo
com.jo
org.jo
net.jo
edu.jo
sch.jo
gov.jo
mil.jo
name.jo

// jobs : https://en.wikipedia.org/wiki/.jobs
jobs

// jp : https://en.wikipedia.org/wiki/.jp
// http://jprs.co.jp/en/jpdomain.html
// Submitted by registry <info@jprs.jp>
jp
// jp organizational type names
ac.jp
ad.jp
co.jp
ed.jp
go.jp
gr.jp
lg.jp
ne.jp
or.jp
// jp prefecture type names
aichi.jp
akita.jp
aomori.jp
chiba.jp
ehime.jp
fukui.jp
fukuoka.jp
fukushima.jp
gifu.jp
gunma.jp
hiroshima.jp
hokkaido.jp
hyogo.jp
ibaraki.jp
ishikawa.jp
iwate.jp
kagawa.jp
kagoshima.jp
kanagawa.jp
kochi.jp
kumamoto.jp
kyoto.jp
mie.jp
miyagi.jp
miyazaki.jp
nagano.jp
nagasaki.jp
nara.jp
niigata.jp
oita.jp
okayama.jp
okinawa.jp
osaka.jp
saga.jp
saitama.jp
shiga.jp
shimane.jp
shizuoka.jp
tochigi.jp
tokushima.jp
tokyo.jp
tottori.jp
toyama.jp
wakayama.jp
yamagata.jp
yamaguchi.jp
yamanashi.jp
xn--4pvxs.jp
xn--vgu402c.jp
xn--c3s14m.jp
xn--f6qx53a.jp
xn--8pvr4u.jp
xn--uist22h.jp
xn--djrs72d6uy.jp
xn--mkru45i.jp
xn--0trq7p7nn.jp
xn--8ltr62k.jp
xn--2m4a15e.jp
xn--efvn9s.jp
xn--32vp30h.jp
xn--4it797k.jp
xn--1lqs71d.jp
xn--5rtp49c.jp
xn--5js045d.jp
xn--ehqz56n.jp
xn--1lqs03n.jp
xn--qqqt11m.jp
xn--kbrq7o.jp
xn--pssu33l.jp
xn--ntsq17g.jp
xn--uisz3g.jp
xn--6btw5a.jp
xn--1ctwo.jp
xn--6orx2r.jp
xn--rht61e.jp
xn--rht27z.jp
xn--djty4k.jp
xn--nit225k.jp
xn--rht3d.jp
xn--klty5x.jp
xn--kltx9a.jp
xn--kltp7d.jp
xn--uuwu58a.jp
xn--zbx025d.jp
xn--ntso0iqx3a.jp
xn--elqq16h.jp
xn--4it168d.jp
xn--klt787d.jp
xn--rny31h.jp
xn--7t0a264c.jp
xn--5rtq34k.jp
xn--k7yn95e.jp
xn--tor131o.jp
xn--d5qv7z876c.jp
// jp geographic type names
// http://jprs.jp/doc/rule/saisoku-1.html
*.kawasaki.jp
*.kitakyushu.jp
*.kobe.jp
*.nagoya.jp
*.sapporo.jp
*.sendai.jp
*.yokohama.jp
!city.kawasaki.jp
!city.kitakyushu.jp
!city.kobe.jp
!city.nagoya.jp
!city.sapporo.jp
!city.sendai.jp
!city.yokohama.jp
// 4th level registration
aisai.aichi.jp
ama.aichi.jp
anjo.aichi.jp
asuke.aichi.jp
chiryu.aichi.jp
chita.aichi.jp
fuso.aichi.jp
gamagori.aichi.jp
handa.aichi.jp
hazu.aichi.jp
hekinan.aichi.jp
higashiura.aichi.jp
ichinomiya.aichi.jp
inazawa.aichi.jp
inuyama.aichi.jp
isshiki.aichi.jp
iwakura.aichi.jp
kanie.aichi.jp
kariya.aichi.jp
kasugai.aichi.jp
kira.aichi.jp
kiyosu.aichi.jp
komaki.aichi.jp
konan.aichi.jp
kota.aichi.jp
mihama.aichi.jp
miyoshi.aichi.jp
nishio.aichi.jp
nisshin.aichi.jp
obu.aichi.jp
oguchi.aichi.jp
oharu.aichi.jp
okazaki.aichi.jp
owariasahi.aichi.jp
seto.aichi.jp
shikatsu.aichi.jp
shinshiro.aichi.jp
shitara.aichi.jp
tahara.aichi.jp
takahama.aichi.jp
tobishima.aichi.jp
toei.aichi.jp
togo.aichi.jp
tokai.aichi.jp
tokoname.aichi.jp
toyoake.aichi.jp
toyohashi.aichi.jp
toyokawa.aichi.jp
toyone.aichi.jp
toyota.aichi.jp
tsushima.aichi.jp
yatomi.aichi.jp
akita.akita.jp
daisen.akita.jp
fujisato.akita.jp
gojome.akita.jp
hachirogata.akita.jp
happou.akita.jp
higashinaruse.akita.jp
honjo.akita.jp
honjyo.akita.jp
ikawa.akita.jp
kamikoani.akita.jp
kamioka.akita.jp
katagami.akita.jp
kazuno.akita.jp
kitaakita.akita.jp
kosaka.akita.jp
kyowa.akita.jp
misato.akita.jp
mitane.akita.jp
moriyoshi.akita.jp
nikaho.akita.jp
noshiro.akita.jp
odate.akita.jp
oga.akita.jp
ogata.akita.jp
semboku.akita.jp
yokote.akita.jp
yurihonjo.akita.jp
aomori.aomori.jp
gonohe.aomori.jp
hachinohe.aomori.jp
hashikami.aomori.jp
hiranai.aomori.jp
hirosaki.aomori.jp
itayanagi.aomori.jp
kuroishi.aomori.jp
misawa.aomori.jp
mutsu.aomori.jp
nakadomari.aomori.jp
noheji.aomori.jp
oirase.aomori.jp
owani.aomori.jp
rokunohe.aomori.jp
sannohe.aomori.jp
shichinohe.aomori.jp
shingo.aomori.jp
takko.aomori.jp
towada.aomori.jp
tsugaru.aomori.jp
tsuruta.aomori.jp
abiko.chiba.jp
asahi.chiba.jp
chonan.chiba.jp
chosei.chiba.jp
choshi.chiba.jp
chuo.chiba.jp
funabashi.chiba.jp
futtsu.chiba.jp
hanamigawa.chiba.jp
ichihara.chiba.jp
ichikawa.chiba.jp
ichinomiya.chiba.jp
inzai.chiba.jp
isumi.chiba.jp
kamagaya.chiba.jp
kamogawa.chiba.jp
kashiwa.chiba.jp
katori.chiba.jp
katsuura.chiba.jp
kimitsu.chiba.jp
kisarazu.chiba.jp
kozaki.chiba.jp
kujukuri.chiba.jp
kyonan.chiba.jp
matsudo.chiba.jp
midori.chiba.jp
mihama.chiba.jp
minamiboso.chiba.jp
mobara.chiba.jp
mutsuzawa.chiba.jp
nagara.chiba.jp
nagareyama.chiba.jp
narashino.chiba.jp
narita.chiba.jp
noda.chiba.jp
oamishirasato.chiba.jp
omigawa.chiba.jp
onjuku.chiba.jp
otaki.chiba.jp
sakae.chiba.jp
sakura.chiba.jp
shimofusa.chiba.jp
shirako.chiba.jp
shiroi.chiba.jp
shisui.chiba.jp
sodegaura.chiba.jp
sosa.chiba.jp
tako.chiba.jp
tateyama.chiba.jp
togane.chiba.jp
tohnosho.chiba.jp
tomisato.chiba.jp
urayasu.chiba.jp
yachimata.chiba.jp
yachiyo.chiba.jp
yokaichiba.chiba.jp
yokoshibahikari.chiba.jp
yotsukaido.chiba.jp
ainan.ehime.jp
honai.ehime.jp
ikata.ehime.jp
imabari.ehime.jp
iyo.ehime.jp
kamijima.ehime.jp
kihoku.ehime.jp
kumakogen.ehime.jp
masaki.ehime.jp
matsuno.ehime.jp
matsuyama.ehime.jp
namikata.ehime.jp
niihama.ehime.jp
ozu.ehime.jp
saijo.ehime.jp
seiyo.ehime.jp
shikokuchuo.ehime.jp
tobe.ehime.jp
toon.ehime.jp
uchiko.ehime.jp
uwajima.ehime.jp
yawatahama.ehime.jp
echizen.fukui.jp
eiheiji.fukui.jp
fukui.fukui.jp
ikeda.fukui.jp
katsuyama.fukui.jp
mihama.fukui.jp
minamiechizen.fukui.jp
obama.fukui.jp
ohi.fukui.jp
ono.fukui.jp
sabae.fukui.jp
sakai.fukui.jp
takahama.fukui.jp
tsuruga.fukui.jp
wakasa.fukui.jp
ashiya.fukuoka.jp
buzen.fukuoka.jp
chikugo.fukuoka.jp
chikuho.fukuoka.jp
chikujo.fukuoka.jp
chikushino.fukuoka.jp
chikuzen.fukuoka.jp
chuo.fukuoka.jp
dazaifu.fukuoka.jp
fukuchi.fukuoka.jp
hakata.fukuoka.jp
higashi.fukuoka.jp
hirokawa.fukuoka.jp
hisayama.fukuoka.jp
iizuka.fukuoka.jp
inatsuki.fukuoka.jp
kaho.fukuoka.jp
kasuga.fukuoka.jp
kasuya.fukuoka.jp
kawara.fukuoka.jp
keisen.fukuoka.jp
koga.fukuoka.jp
kurate.fukuoka.jp
kurogi.fukuoka.jp
kurume.fukuoka.jp
minami.fukuoka.jp
miyako.fukuoka.jp
miyama.fukuoka.jp
miyawaka.fukuoka.jp
mizumaki.fukuoka.jp
munakata.fukuoka.jp
nakagawa.fukuoka.jp
nakama.fukuoka.jp
nishi.fukuoka.jp
nogata.fukuoka.jp
ogori.fukuoka.jp
okagaki.fukuoka.jp
okawa.fukuoka.jp
oki.fukuoka.jp
omuta.fukuoka.jp
onga.fukuoka.jp
onojo.fukuoka.jp
oto.fukuoka.jp
saigawa.fukuoka.jp
sasaguri.fukuoka.jp
shingu.fukuoka.jp
shinyoshitomi.fukuoka.jp
shonai.fukuoka.jp
soeda.fukuoka.jp
sue.fukuoka.jp
tachiarai.fukuoka.jp
tagawa.fukuoka.jp
takata.fukuoka.jp
toho.fukuoka.jp
toyotsu.fukuoka.jp
tsuiki.fukuoka.jp
ukiha.fukuoka.jp
umi.fukuoka.jp
usui.fukuoka.jp
yamada.fukuoka.jp
yame.fukuoka.jp
yanagawa.fukuoka.jp
yukuhashi.fukuoka.jp
aizubange.fukushima.jp
aizumisato.fukushima.jp
aizuwakamatsu.fukushima.jp
asakawa.fukushima.jp
bandai.fukushima.jp
date.fukushima.jp
fukushima.fukushima.jp
furudono.fukushima.jp
futaba.fukushima.jp
hanawa.fukushima.jp
higashi.fukushima.jp
hirata.fukushima.jp
hirono.fukushima.jp
iitate.fukushima.jp
inawashiro.fukushima.jp
ishikawa.fukushima.jp
iwaki.fukushima.jp
izumizaki.fukushima.jp
kagamiishi.fukushima.jp
kaneyama.fukushima.jp
kawamata.fukushima.jp
kitakata.fukushima.jp
kitashiobara.fukushima.jp
koori.fukushima.jp
koriyama.fukushima.jp
kunimi.fukushima.jp
miharu.fukushima.jp
mishima.fukushima.jp
namie.fukushima.jp
nango.fukushima.jp
nishiaizu.fukushima.jp
nishigo.fukushima.jp
okuma.fukushima.jp
omotego.fukushima.jp
ono.fukushima.jp
otama.fukushima.jp
samegawa.fukushima.jp
shimogo.fukushima.jp
shirakawa.fukushima.jp
showa.fukushima.jp
soma.fukushima.jp
sukagawa.fukushima.jp
taishin.fukushima.jp
tamakawa.fukushima.jp
tanagura.fukushima.jp
tenei.fukushima.jp
yabuki.fukushima.jp
yamato.fukushima.jp
yamatsuri.fukushima.jp
yanaizu.fukushima.jp
yugawa.fukushima.jp
anpachi.gifu.jp
ena.gifu.jp
gifu.gifu.jp
ginan.gifu.jp
godo.gifu.jp
gujo.gifu.jp
hashima.gifu.jp
hichiso.gifu.jp
hida.gifu.jp
higashishirakawa.gifu.jp
ibigawa.gifu.jp
ikeda.gifu.jp
kakamigahara.gifu.jp
kani.gifu.jp
kasahara.gifu.jp
kasamatsu.gifu.jp
kawaue.gifu.jp
kitagata.gifu.jp
mino.gifu.jp
minokamo.gifu.jp
mitake.gifu.jp
mizunami.gifu.jp
motosu.gifu.jp
nakatsugawa.gifu.jp
ogaki.gifu.jp
sakahogi.gifu.jp
seki.gifu.jp
sekigahara.gifu.jp
shirakawa.gifu.jp
tajimi.gifu.jp
takayama.gifu.jp
tarui.gifu.jp
toki.gifu.jp
tomika.gifu.jp
wanouchi.gifu.jp
yamagata.gifu.jp
yaotsu.gifu.jp
yoro.gifu.jp
annaka.gunma.jp
chiyoda.gunma.jp
fujioka.gunma.jp
higashiagatsuma.gunma.jp
isesaki.gunma.jp
itakura.gunma.jp
kanna.gunma.jp
kanra.gunma.jp
katashina.gunma.jp
kawaba.gunma.jp
kiryu.gunma.jp
kusatsu.gunma.jp
maebashi.gunma.jp
meiwa.gunma.jp
midori.gunma.jp
minakami.gunma.jp
naganohara.gunma.jp
nakanojo.gunma.jp
nanmoku.gunma.jp
numata.gunma.jp
oizumi.gunma.jp
ora.gunma.jp
ota.gunma.jp
shibukawa.gunma.jp
shimonita.gunma.jp
shinto.gunma.jp
showa.gunma.jp
takasaki.gunma.jp
takayama.gunma.jp
tamamura.gunma.jp
tatebayashi.gunma.jp
tomioka.gunma.jp
tsukiyono.gunma.jp
tsumagoi.gunma.jp
ueno.gunma.jp
yoshioka.gunma.jp
asaminami.hiroshima.jp
daiwa.hiroshima.jp
etajima.hiroshima.jp
fuchu.hiroshima.jp
fukuyama.hiroshima.jp
hatsukaichi.hiroshima.jp
higashihiroshima.hiroshima.jp
hongo.hiroshima.jp
jinsekikogen.hiroshima.jp
kaita.hiroshima.jp
kui.hiroshima.jp
kumano.hiroshima.jp
kure.hiroshima.jp
mihara.hiroshima.jp
miyoshi.hiroshima.jp
naka.hiroshima.jp
onomichi.hiroshima.jp
osakikamijima.hiroshima.jp
otake.hiroshima.jp
saka.hiroshima.jp
sera.hiroshima.jp
seranishi.hiroshima.jp
shinichi.hiroshima.jp
shobara.hiroshima.jp
takehara.hiroshima.jp
abashiri.hokkaido.jp
abira.hokkaido.jp
aibetsu.hokkaido.jp
akabira.hokkaido.jp
akkeshi.hokkaido.jp
asahikawa.hokkaido.jp
ashibetsu.hokkaido.jp
ashoro.hokkaido.jp
assabu.hokkaido.jp
atsuma.hokkaido.jp
bibai.hokkaido.jp
biei.hokkaido.jp
bifuka.hokkaido.jp
bihoro.hokkaido.jp
biratori.hokkaido.jp
chippubetsu.hokkaido.jp
chitose.hokkaido.jp
date.hokkaido.jp
ebetsu.hokkaido.jp
embetsu.hokkaido.jp
eniwa.hokkaido.jp
erimo.hokkaido.jp
esan.hokkaido.jp
esashi.hokkaido.jp
fukagawa.hokkaido.jp
fukushima.hokkaido.jp
furano.hokkaido.jp
furubira.hokkaido.jp
haboro.hokkaido.jp
hakodate.hokkaido.jp
hamatonbetsu.hokkaido.jp
hidaka.hokkaido.jp
higashikagura.hokkaido.jp
higashikawa.hokkaido.jp
hiroo.hokkaido.jp
hokuryu.hokkaido.jp
hokuto.hokkaido.jp
honbetsu.hokkaido.jp
horokanai.hokkaido.jp
horonobe.hokkaido.jp
ikeda.hokkaido.jp
imakane.hokkaido.jp
ishikari.hokkaido.jp
iwamizawa.hokkaido.jp
iwanai.hokkaido.jp
kamifurano.hokkaido.jp
kamikawa.hokkaido.jp
kamishihoro.hokkaido.jp
kamisunagawa.hokkaido.jp
kamoenai.hokkaido.jp
kayabe.hokkaido.jp
kembuchi.hokkaido.jp
kikonai.hokkaido.jp
kimobetsu.hokkaido.jp
kitahiroshima.hokkaido.jp
kitami.hokkaido.jp
kiyosato.hokkaido.jp
koshimizu.hokkaido.jp
kunneppu.hokkaido.jp
kuriyama.hokkaido.jp
kuromatsunai.hokkaido.jp
kushiro.hokkaido.jp
kutchan.hokkaido.jp
kyowa.hokkaido.jp
mashike.hokkaido.jp
matsumae.hokkaido.jp
mikasa.hokkaido.jp
minamifurano.hokkaido.jp
mombetsu.hokkaido.jp
moseushi.hokkaido.jp
mukawa.hokkaido.jp
muroran.hokkaido.jp
naie.hokkaido.jp
nakagawa.hokkaido.jp
nakasatsunai.hokkaido.jp
nakatombetsu.hokkaido.jp
nanae.hokkaido.jp
nanporo.hokkaido.jp
nayoro.hokkaido.jp
nemuro.hokkaido.jp
niikappu.hokkaido.jp
niki.hokkaido.jp
nishiokoppe.hokkaido.jp
noboribetsu.hokkaido.jp
numata.hokkaido.jp
obihiro.hokkaido.jp
obira.hokkaido.jp
oketo.hokkaido.jp
okoppe.hokkaido.jp
otaru.hokkaido.jp
otobe.hokkaido.jp
otofuke.hokkaido.jp
otoineppu.hokkaido.jp
oumu.hokkaido.jp
ozora.hokkaido.jp
pippu.hokkaido.jp
rankoshi.hokkaido.jp
rebun.hokkaido.jp
rikubetsu.hokkaido.jp
rishiri.hokkaido.jp
rishirifuji.hokkaido.jp
saroma.hokkaido.jp
sarufutsu.hokkaido.jp
shakotan.hokkaido.jp
shari.hokkaido.jp
shibecha.hokkaido.jp
shibetsu.hokkaido.jp
shikabe.hokkaido.jp
shikaoi.hokkaido.jp
shimamaki.hokkaido.jp
shimizu.hokkaido.jp
shimokawa.hokkaido.jp
shinshinotsu.hokkaido.jp
shintoku.hokkaido.jp
shiranuka.hokkaido.jp
shiraoi.hokkaido.jp
shiriuchi.hokkaido.jp
sobetsu.hokkaido.jp
sunagawa.hokkaido.jp
taiki.hokkaido.jp
takasu.hokkaido.jp
takikawa.hokkaido.jp
takinoue.hokkaido.jp
teshikaga.hokkaido.jp
tobetsu.hokkaido.jp
tohma.hokkaido.jp
tomakomai.hokkaido.jp
tomari.hokkaido.jp
toya.hokkaido.jp
toyako.hokkaido.jp
toyotomi.hokkaido.jp
toyoura.hokkaido.jp
tsubetsu.hokkaido.jp
tsukigata.hokkaido.jp
urakawa.hokkaido.jp
urausu.hokkaido.jp
uryu.hokkaido.jp
utashinai.hokkaido.jp
wakkanai.hokkaido.jp
wassamu.hokkaido.jp
yakumo.hokkaido.jp
yoichi.hokkaido.jp
aioi.hyogo.jp
akashi.hyogo.jp
ako.hyogo.jp
amagasaki.hyogo.jp
aogaki.hyogo.jp
asago.hyogo.jp
ashiya.hyogo.jp
awaji.hyogo.jp
fukusaki.hyogo.jp
goshiki.hyogo.jp
harima.hyogo.jp
himeji.hyogo.jp
ichikawa.hyogo.jp
inagawa.hyogo.jp
itami.hyogo.jp
kakogawa.hyogo.jp
kamigori.hyogo.jp
kamikawa.hyogo.jp
kasai.hyogo.jp
kasuga.hyogo.jp
kawanishi.hyogo.jp
miki.hyogo.jp
minamiawaji.hyogo.jp
nishinomiya.hyogo.jp
nishiwaki.hyogo.jp
ono.hyogo.jp
sanda.hyogo.jp
sannan.hyogo.jp
sasayama.hyogo.jp
sayo.hyogo.jp
shingu.hyogo.jp
shinonsen.hyogo.jp
shiso.hyogo.jp
sumoto.hyogo.jp
taishi.hyogo.jp
taka.hyogo.jp
takarazuka.hyogo.jp
takasago.hyogo.jp
takino.hyogo.jp
tamba.hyogo.jp
tatsuno.hyogo.jp
toyooka.hyogo.jp
yabu.hyogo.jp
yashiro.hyogo.jp
yoka.hyogo.jp
yokawa.hyogo.jp
ami.ibaraki.jp
asahi.ibaraki.jp
bando.ibaraki.jp
chikusei.ibaraki.jp
daigo.ibaraki.jp
fujishiro.ibaraki.jp
hitachi.ibaraki.jp
hitachinaka.ibaraki.jp
hitachiomiya.ibaraki.jp
hitachiota.ibaraki.jp
ibaraki.ibaraki.jp
ina.ibaraki.jp
inashiki.ibaraki.jp
itako.ibaraki.jp
iwama.ibaraki.jp
joso.ibaraki.jp
kamisu.ibaraki.jp
kasama.ibaraki.jp
kashima.ibaraki.jp
kasumigaura.ibaraki.jp
koga.ibaraki.jp
miho.ibaraki.jp
mito.ibaraki.jp
moriya.ibaraki.jp
naka.ibaraki.jp
namegata.ibaraki.jp
oarai.ibaraki.jp
ogawa.ibaraki.jp
omitama.ibaraki.jp
ryugasaki.ibaraki.jp
sakai.ibaraki.jp
sakuragawa.ibaraki.jp
shimodate.ibaraki.jp
shimotsuma.ibaraki.jp
shirosato.ibaraki.jp
sowa.ibaraki.jp
suifu.ibaraki.jp
takahagi.ibaraki.jp
tamatsukuri.ibaraki.jp
tokai.ibaraki.jp
tomobe.ibaraki.jp
tone.ibaraki.jp
toride.ibaraki.jp
tsuchiura.ibaraki.jp
tsukuba.ibaraki.jp
uchihara.ibaraki.jp
ushiku.ibaraki.jp
yachiyo.ibaraki.jp
yamagata.ibaraki.jp
yawara.ibaraki.jp
yuki.ibaraki.jp
anamizu.ishikawa.jp
hakui.ishikawa.jp
hakusan.ishikawa.jp
kaga.ishikawa.jp
kahoku.ishikawa.jp
kanazawa.ishikawa.jp
kawakita.ishikawa.jp
komatsu.ishikawa.jp
nakanoto.ishikawa.jp
nanao.ishikawa.jp
nomi.ishikawa.jp
nonoichi.ishikawa.jp
noto.ishikawa.jp
shika.ishikawa.jp
suzu.ishikawa.jp
tsubata.ishikawa.jp
tsurugi.ishikawa.jp
uchinada.ishikawa.jp
wajima.ishikawa.jp
fudai.iwate.jp
fujisawa.iwate.jp
hanamaki.iwate.jp
hiraizumi.iwate.jp
hirono.iwate.jp
ichinohe.iwate.jp
ichinoseki.iwate.jp
iwaizumi.iwate.jp
iwate.iwate.jp
joboji.iwate.jp
kamaishi.iwate.jp
kanegasaki.iwate.jp
karumai.iwate.jp
kawai.iwate.jp
kitakami.iwate.jp
kuji.iwate.jp
kunohe.iwate.jp
kuzumaki.iwate.jp
miyako.iwate.jp
mizusawa.iwate.jp
morioka.iwate.jp
ninohe.iwate.jp
noda.iwate.jp
ofunato.iwate.jp
oshu.iwate.jp
otsuchi.iwate.jp
rikuzentakata.iwate.jp
shiwa.iwate.jp
shizukuishi.iwate.jp
sumita.iwate.jp
tanohata.iwate.jp
tono.iwate.jp
yahaba.iwate.jp
yamada.iwate.jp
ayagawa.kagawa.jp
higashikagawa.kagawa.jp
kanonji.kagawa.jp
kotohira.kagawa.jp
manno.kagawa.jp
marugame.kagawa.jp
mitoyo.kagawa.jp
naoshima.kagawa.jp
sanuki.kagawa.jp
tadotsu.kagawa.jp
takamatsu.kagawa.jp
tonosho.kagawa.jp
uchinomi.kagawa.jp
utazu.kagawa.jp
zentsuji.kagawa.jp
akune.kagoshima.jp
amami.kagoshima.jp
hioki.kagoshima.jp
isa.kagoshima.jp
isen.kagoshima.jp
izumi.kagoshima.jp
kagoshima.kagoshima.jp
kanoya.kagoshima.jp
kawanabe.kagoshima.jp
kinko.kagoshima.jp
kouyama.kagoshima.jp
makurazaki.kagoshima.jp
matsumoto.kagoshima.jp
minamitane.kagoshima.jp
nakatane.kagoshima.jp
nishinoomote.kagoshima.jp
satsumasendai.kagoshima.jp
soo.kagoshima.jp
tarumizu.kagoshima.jp
yusui.kagoshima.jp
aikawa.kanagawa.jp
atsugi.kanagawa.jp
ayase.kanagawa.jp
chigasaki.kanagawa.jp
ebina.kanagawa.jp
fujisawa.kanagawa.jp
hadano.kanagawa.jp
hakone.kanagawa.jp
hiratsuka.kanagawa.jp
isehara.kanagawa.jp
kaisei.kanagawa.jp
kamakura.kanagawa.jp
kiyokawa.kanagawa.jp
matsuda.kanagawa.jp
minamiashigara.kanagawa.jp
miura.kanagawa.jp
nakai.kanagawa.jp
ninomiya.kanagawa.jp
odawara.kanagawa.jp
oi.kanagawa.jp
oiso.kanagawa.jp
sagamihara.kanagawa.jp
samukawa.kanagawa.jp
tsukui.kanagawa.jp
yamakita.kanagawa.jp
yamato.kanagawa.jp
yokosuka.kanagawa.jp
yugawara.kanagawa.jp
zama.kanagawa.jp
zushi.kanagawa.jp
aki.kochi.jp
geisei.kochi.jp
hidaka.kochi.jp
higashitsuno.kochi.jp
ino.kochi.jp
kagami.kochi.jp
kami.kochi.jp
kitagawa.kochi.jp
kochi.kochi.jp
mihara.kochi.jp
motoyama.kochi.jp
muroto.kochi.jp
nahari.kochi.jp
nakamura.kochi.jp
nankoku.kochi.jp
nishitosa.kochi.jp
niyodogawa.kochi.jp
ochi.kochi.jp
okawa.kochi.jp
otoyo.kochi.jp
otsuki.kochi.jp
sakawa.kochi.jp
sukumo.kochi.jp
susaki.kochi.jp
tosa.kochi.jp
tosashimizu.kochi.jp
toyo.kochi.jp
tsuno.kochi.jp
umaji.kochi.jp
yasuda.kochi.jp
yusuhara.kochi.jp
amakusa.kumamoto.jp
arao.kumamoto.jp
aso.kumamoto.jp
choyo.kumamoto.jp
gyokuto.kumamoto.jp
kamiamakusa.kumamoto.jp
kikuchi.kumamoto.jp
kumamoto.kumamoto.jp
mashiki.kumamoto.jp
mifune.kumamoto.jp
minamata.kumamoto.jp
minamioguni.kumamoto.jp
nagasu.kumamoto.jp
nishihara.kumamoto.jp
oguni.kumamoto.jp
ozu.kumamoto.jp
sumoto.kumamoto.jp
takamori.kumamoto.jp
uki.kumamoto.jp
uto.kumamoto.jp
yamaga.kumamoto.jp
yamato.kumamoto.jp
yatsushiro.kumamoto.jp
ayabe.kyoto.jp
fukuchiyama.kyoto.jp
higashiyama.kyoto.jp
ide.kyoto.jp
ine.kyoto.jp
joyo.kyoto.jp
kameoka.kyoto.jp
kamo.kyoto.jp
kita.kyoto.jp
kizu.kyoto.jp
kumiyama.kyoto.jp
kyotamba.kyoto.jp
kyotanabe.kyoto.jp
kyotango.kyoto.jp
maizuru.kyoto.jp
minami.kyoto.jp
minamiyamashiro.kyoto.jp
miyazu.kyoto.jp
muko.kyoto.jp
nagaokakyo.kyoto.jp
nakagyo.kyoto.jp
nantan.kyoto.jp
oyamazaki.kyoto.jp
sakyo.kyoto.jp
seika.kyoto.jp
tanabe.kyoto.jp
uji.kyoto.jp
ujitawara.kyoto.jp
wazuka.kyoto.jp
yamashina.kyoto.jp
yawata.kyoto.jp
asahi.mie.jp
inabe.mie.jp
ise.mie.jp
kameyama.mie.jp
kawagoe.mie.jp
kiho.mie.jp
kisosaki.mie.jp
kiwa.mie.jp
komono.mie.jp
kumano.mie.jp
kuwana.mie.jp
matsusaka.mie.jp
meiwa.mie.jp
mihama.mie.jp
minamiise.mie.jp
misugi.mie.jp
miyama.mie.jp
nabari.mie.jp
shima.mie.jp
suzuka.mie.jp
tado.mie.jp
taiki.mie.jp
taki.mie.jp
tamaki.mie.jp
toba.mie.jp
tsu.mie.jp
udono.mie.jp
ureshino.mie.jp
watarai.mie.jp
yokkaichi.mie.jp
furukawa.miyagi.jp
higashimatsushima.miyagi.jp
ishinomaki.miyagi.jp
iwanuma.miyagi.jp
kakuda.miyagi.jp
kami.miyagi.jp
kawasaki.miyagi.jp
marumori.miyagi.jp
matsushima.miyagi.jp
minamisanriku.miyagi.jp
misato.miyagi.jp
murata.miyagi.jp
natori.miyagi.jp
ogawara.miyagi.jp
ohira.miyagi.jp
onagawa.miyagi.jp
osaki.miyagi.jp
rifu.miyagi.jp
semine.miyagi.jp
shibata.miyagi.jp
shichikashuku.miyagi.jp
shikama.miyagi.jp
shiogama.miyagi.jp
shiroishi.miyagi.jp
tagajo.miyagi.jp
taiwa.miyagi.jp
tome.miyagi.jp
tomiya.miyagi.jp
wakuya.miyagi.jp
watari.miyagi.jp
yamamoto.miyagi.jp
zao.miyagi.jp
aya.miyazaki.jp
ebino.miyazaki.jp
gokase.miyazaki.jp
hyuga.miyazaki.jp
kadogawa.miyazaki.jp
kawaminami.miyazaki.jp
kijo.miyazaki.jp
kitagawa.miyazaki.jp
kitakata.miyazaki.jp
kitaura.miyazaki.jp
kobayashi.miyazaki.jp
kunitomi.miyazaki.jp
kushima.miyazaki.jp
mimata.miyazaki.jp
miyakonojo.miyazaki.jp
miyazaki.miyazaki.jp
morotsuka.miyazaki.jp
nichinan.miyazaki.jp
nishimera.miyazaki.jp
nobeoka.miyazaki.jp
saito.miyazaki.jp
shiiba.miyazaki.jp
shintomi.miyazaki.jp
takaharu.miyazaki.jp
takanabe.miyazaki.jp
takazaki.miyazaki.jp
tsuno.miyazaki.jp
achi.nagano.jp
agematsu.nagano.jp
anan.nagano.jp
aoki.nagano.jp
asahi.nagano.jp
azumino.nagano.jp
chikuhoku.nagano.jp
chikuma.nagano.jp
chino.nagano.jp
fujimi.nagano.jp
hakuba.nagano.jp
hara.nagano.jp
hiraya.nagano.jp
iida.nagano.jp
iijima.nagano.jp
iiyama.nagano.jp
iizuna.nagano.jp
ikeda.nagano.jp
ikusaka.nagano.jp
ina.nagano.jp
karuizawa.nagano.jp
kawakami.nagano.jp
kiso.nagano.jp
kisofukushima.nagano.jp
kitaaiki.nagano.jp
komagane.nagano.jp
komoro.nagano.jp
matsukawa.nagano.jp
matsumoto.nagano.jp
miasa.nagano.jp
minamiaiki.nagano.jp
minamimaki.nagano.jp
minamiminowa.nagano.jp
minowa.nagano.jp
miyada.nagano.jp
miyota.nagano.jp
mochizuki.nagano.jp
nagano.nagano.jp
nagawa.nagano.jp
nagiso.nagano.jp
nakagawa.nagano.jp
nakano.nagano.jp
nozawaonsen.nagano.jp
obuse.nagano.jp
ogawa.nagano.jp
okaya.nagano.jp
omachi.nagano.jp
omi.nagano.jp
ookuwa.nagano.jp
ooshika.nagano.jp
otaki.nagano.jp
otari.nagano.jp
sakae.nagano.jp
sakaki.nagano.jp
saku.nagano.jp
sakuho.nagano.jp
shimosuwa.nagano.jp
shinanomachi.nagano.jp
shiojiri.nagano.jp
suwa.nagano.jp
suzaka.nagano.jp
takagi.nagano.jp
takamori.nagano.jp
takayama.nagano.jp
tateshina.nagano.jp
tatsuno.nagano.jp
togakushi.nagano.jp
togura.nagano.jp
tomi.nagano.jp
ueda.nagano.jp
wada.nagano.jp
yamagata.nagano.jp
yamanouchi.nagano.jp
yasaka.nagano.jp
yasuoka.nagano.jp
chijiwa.nagasaki.jp
futsu.nagasaki.jp
goto.nagasaki.jp
hasami.nagasaki.jp
hirado.nagasaki.jp
iki.nagasaki.jp
isahaya.nagasaki.jp
kawatana.nagasaki.jp
kuchinotsu.nagasaki.jp
matsuura.nagasaki.jp
nagasaki.nagasaki.jp
obama.nagasaki.jp
omura.nagasaki.jp
oseto.nagasaki.jp
saikai.nagasaki.jp
sasebo.nagasaki.jp
seihi.nagasaki.jp
shimabara.nagasaki.jp
shinkamigoto.nagasaki.jp
togitsu.nagasaki.jp
tsushima.nagasaki.jp
unzen.nagasaki.jp
ando.nara.jp
gose.nara.jp
heguri.nara.jp
higashiyoshino.nara.jp
ikaruga.nara.jp
ikoma.nara.jp
kamikitayama.nara.jp
kanmaki.nara.jp
kashiba.nara.jp
kashihara.nara.jp
katsuragi.nara.jp
kawai.nara.jp
kawakami.nara.jp
kawanishi.nara.jp
koryo.nara.jp
kurotaki.nara.jp
mitsue.nara.jp
miyake.nara.jp
nara.nara.jp
nosegawa.nara.jp
oji.nara.jp
ouda.nara.jp
oyodo.nara.jp
sakurai.nara.jp
sango.nara.jp
shimoichi.nara.jp
shimokitayama.nara.jp
shinjo.nara.jp
soni.nara.jp
takatori.nara.jp
tawaramoto.nara.jp
tenkawa.nara.jp
tenri.nara.jp
uda.nara.jp
yamatokoriyama.nara.jp
yamatotakada.nara.jp
yamazoe.nara.jp
yoshino.nara.jp
aga.niigata.jp
agano.niigata.jp
gosen.niigata.jp
itoigawa.niigata.jp
izumozaki.niigata.jp
joetsu.niigata.jp
kamo.niigata.jp
kariwa.niigata.jp
kashiwazaki.niigata.jp
minamiuonuma.niigata.jp
mitsuke.niigata.jp
muika.niigata.jp
murakami.niigata.jp
myoko.niigata.jp
nagaoka.niigata.jp
niigata.niigata.jp
ojiya.niigata.jp
omi.niigata.jp
sado.niigata.jp
sanjo.niigata.jp
seiro.niigata.jp
seirou.niigata.jp
sekikawa.niigata.jp
shibata.niigata.jp
tagami.niigata.jp
tainai.niigata.jp
tochio.niigata.jp
tokamachi.niigata.jp
tsubame.niigata.jp
tsunan.niigata.jp
uonuma.niigata.jp
yahiko.niigata.jp
yoita.niigata.jp
yuzawa.niigata.jp
beppu.oita.jp
bungoono.oita.jp
bungotakada.oita.jp
hasama.oita.jp
hiji.oita.jp
himeshima.oita.jp
hita.oita.jp
kamitsue.oita.jp
kokonoe.oita.jp
kuju.oita.jp
kunisaki.oita.jp
kusu.oita.jp
oita.oita.jp
saiki.oita.jp
taketa.oita.jp
tsukumi.oita.jp
usa.oita.jp
usuki.oita.jp
yufu.oita.jp
akaiwa.okayama.jp
asakuchi.okayama.jp
bizen.okayama.jp
hayashima.okayama.jp
ibara.okayama.jp
kagamino.okayama.jp
kasaoka.okayama.jp
kibichuo.okayama.jp
kumenan.okayama.jp
kurashiki.okayama.jp
maniwa.okayama.jp
misaki.okayama.jp
nagi.okayama.jp
niimi.okayama.jp
nishiawakura.okayama.jp
okayama.okayama.jp
satosho.okayama.jp
setouchi.okayama.jp
shinjo.okayama.jp
shoo.okayama.jp
soja.okayama.jp
takahashi.okayama.jp
tamano.okayama.jp
tsuyama.okayama.jp
wake.okayama.jp
yakage.okayama.jp
aguni.okinawa.jp
ginowan.okinawa.jp
ginoza.okinawa.jp
gushikami.okinawa.jp
haebaru.okinawa.jp
higashi.okinawa.jp
hirara.okinawa.jp
iheya.okinawa.jp
ishigaki.okinawa.jp
ishikawa.okinawa.jp
itoman.okinawa.jp
izena.okinawa.jp
kadena.okinawa.jp
kin.okinawa.jp
kitadaito.okinawa.jp
kitanakagusuku.okinawa.jp
kumejima.okinawa.jp
kunigami.okinawa.jp
minamidaito.okinawa.jp
motobu.okinawa.jp
nago.okinawa.jp
naha.okinawa.jp
nakagusuku.okinawa.jp
nakijin.okinawa.jp
nanjo.okinawa.jp
nishihara.okinawa.jp
ogimi.okinawa.jp
okinawa.okinawa.jp
onna.okinawa.jp
shimoji.okinawa.jp
taketomi.okinawa.jp
tarama.okinawa.jp
tokashiki.okinawa.jp
tomigusuku.okinawa.jp
tonaki.okinawa.jp
urasoe.okinawa.jp
uruma.okinawa.jp
yaese.okinawa.jp
yomitan.okinawa.jp
yonabaru.okinawa.jp
yonaguni.okinawa.jp
zamami.okinawa.jp
abeno.osaka.jp
chihayaakasaka.osaka.jp
chuo.osaka.jp
daito.osaka.jp
fujiidera.osaka.jp
habikino.osaka.jp
hannan.osaka.jp
higashiosaka.osaka.jp
higashisumiyoshi.osaka.jp
higashiyodogawa.osaka.jp
hirakata.osaka.jp
ibaraki.osaka.jp
ikeda.osaka.jp
izumi.osaka.jp
izumiotsu.osaka.jp
izumisano.osaka.jp
kadoma.osaka.jp
kaizuka.osaka.jp
kanan.osaka.jp
kashiwara.osaka.jp
katano.osaka.jp
kawachinagano.osaka.jp
kishiwada.osaka.jp
kita.osaka.jp
kumatori.osaka.jp
matsubara.osaka.jp
minato.osaka.jp
minoh.osaka.jp
misaki.osaka.jp
moriguchi.osaka.jp
neyagawa.osaka.jp
nishi.osaka.jp
nose.osaka.jp
osakasayama.osaka.jp
sakai.osaka.jp
sayama.osaka.jp
sennan.osaka.jp
settsu.osaka.jp
shijonawate.osaka.jp
shimamoto.osaka.jp
suita.osaka.jp
tadaoka.osaka.jp
taishi.osaka.jp
tajiri.osaka.jp
takaishi.osaka.jp
takatsuki.osaka.jp
tondabayashi.osaka.jp
toyonaka.osaka.jp
toyono.osaka.jp
yao.osaka.jp
ariake.saga.jp
arita.saga.jp
fukudomi.saga.jp
genkai.saga.jp
hamatama.saga.jp
hizen.saga.jp
imari.saga.jp
kamimine.saga.jp
kanzaki.saga.jp
karatsu.saga.jp
kashima.saga.jp
kitagata.saga.jp
kitahata.saga.jp
kiyama.saga.jp
kouhoku.saga.jp
kyuragi.saga.jp
nishiarita.saga.jp
ogi.saga.jp
omachi.saga.jp
ouchi.saga.jp
saga.saga.jp
shiroishi.saga.jp
taku.saga.jp
tara.saga.jp
tosu.saga.jp
yoshinogari.saga.jp
arakawa.saitama.jp
asaka.saitama.jp
chichibu.saitama.jp
fujimi.saitama.jp
fujimino.saitama.jp
fukaya.saitama.jp
hanno.saitama.jp
hanyu.saitama.jp
hasuda.saitama.jp
hatogaya.saitama.jp
hatoyama.saitama.jp
hidaka.saitama.jp
higashichichibu.saitama.jp
higashimatsuyama.saitama.jp
honjo.saitama.jp
ina.saitama.jp
iruma.saitama.jp
iwatsuki.saitama.jp
kamiizumi.saitama.jp
kamikawa.saitama.jp
kamisato.saitama.jp
kasukabe.saitama.jp
kawagoe.saitama.jp
kawaguchi.saitama.jp
kawajima.saitama.jp
kazo.saitama.jp
kitamoto.saitama.jp
koshigaya.saitama.jp
kounosu.saitama.jp
kuki.saitama.jp
kumagaya.saitama.jp
matsubushi.saitama.jp
minano.saitama.jp
misato.saitama.jp
miyashiro.saitama.jp
miyoshi.saitama.jp
moroyama.saitama.jp
nagatoro.saitama.jp
namegawa.saitama.jp
niiza.saitama.jp
ogano.saitama.jp
ogawa.saitama.jp
ogose.saitama.jp
okegawa.saitama.jp
omiya.saitama.jp
otaki.saitama.jp
ranzan.saitama.jp
ryokami.saitama.jp
saitama.saitama.jp
sakado.saitama.jp
satte.saitama.jp
sayama.saitama.jp
shiki.saitama.jp
shiraoka.saitama.jp
soka.saitama.jp
sugito.saitama.jp
toda.saitama.jp
tokigawa.saitama.jp
tokorozawa.saitama.jp
tsurugashima.saitama.jp
urawa.saitama.jp
warabi.saitama.jp
yashio.saitama.jp
yokoze.saitama.jp
yono.saitama.jp
yorii.saitama.jp
yoshida.saitama.jp
yoshikawa.saitama.jp
yoshimi.saitama.jp
aisho.shiga.jp
gamo.shiga.jp
higashiomi.shiga.jp
hikone.shiga.jp
koka.shiga.jp
konan.shiga.jp
kosei.shiga.jp
koto.shiga.jp
kusatsu.shiga.jp
maibara.shiga.jp
moriyama.shiga.jp
nagahama.shiga.jp
nishiazai.shiga.jp
notogawa.shiga.jp
omihachiman.shiga.jp
otsu.shiga.jp
ritto.shiga.jp
ryuoh.shiga.jp
takashima.shiga.jp
takatsuki.shiga.jp
torahime.shiga.jp
toyosato.shiga.jp
yasu.shiga.jp
akagi.shimane.jp
ama.shimane.jp
gotsu.shimane.jp
hamada.shimane.jp
higashiizumo.shimane.jp
hikawa.shimane.jp
hikimi.shimane.jp
izumo.shimane.jp
kakinoki.shimane.jp
masuda.shimane.jp
matsue.shimane.jp
misato.shimane.jp
nishinoshima.shimane.jp
ohda.shimane.jp
okinoshima.shimane.jp
okuizumo.shimane.jp
shimane.shimane.jp
tamayu.shimane.jp
tsuwano.shimane.jp
unnan.shimane.jp
yakumo.shimane.jp
yasugi.shimane.jp
yatsuka.shimane.jp
arai.shizuoka.jp
atami.shizuoka.jp
fuji.shizuoka.jp
fujieda.shizuoka.jp
fujikawa.shizuoka.jp
fujinomiya.shizuoka.jp
fukuroi.shizuoka.jp
gotemba.shizuoka.jp
haibara.shizuoka.jp
hamamatsu.shizuoka.jp
higashiizu.shizuoka.jp
ito.shizuoka.jp
iwata.shizuoka.jp
izu.shizuoka.jp
izunokuni.shizuoka.jp
kakegawa.shizuoka.jp
kannami.shizuoka.jp
kawanehon.shizuoka.jp
kawazu.shizuoka.jp
kikugawa.shizuoka.jp
kosai.shizuoka.jp
makinohara.shizuoka.jp
matsuzaki.shizuoka.jp
minamiizu.shizuoka.jp
mishima.shizuoka.jp
morimachi.shizuoka.jp
nishiizu.shizuoka.jp
numazu.shizuoka.jp
omaezaki.shizuoka.jp
shimada.shizuoka.jp
shimizu.shizuoka.jp
shimoda.shizuoka.jp
shizuoka.shizuoka.jp
susono.shizuoka.jp
yaizu.shizuoka.jp
yoshida.shizuoka.jp
ashikaga.tochigi.jp
bato.tochigi.jp
haga.tochigi.jp
ichikai.tochigi.jp
iwafune.tochigi.jp
kaminokawa.tochigi.jp
kanuma.tochigi.jp
karasuyama.tochigi.jp
kuroiso.tochigi.jp
mashiko.tochigi.jp
mibu.tochigi.jp
moka.tochigi.jp
motegi.tochigi.jp
nasu.tochigi.jp
nasushiobara.tochigi.jp
nikko.tochigi.jp
nishikata.tochigi.jp
nogi.tochigi.jp
ohira.tochigi.jp
ohtawara.tochigi.jp
oyama.tochigi.jp
sakura.tochigi.jp
sano.tochigi.jp
shimotsuke.tochigi.jp
shioya.tochigi.jp
takanezawa.tochigi.jp
tochigi.tochigi.jp
tsuga.tochigi.jp
ujiie.tochigi.jp
utsunomiya.tochigi.jp
yaita.tochigi.jp
aizumi.tokushima.jp
anan.tokushima.jp
ichiba.tokushima.jp
itano.tokushima.jp
kainan.tokushima.jp
komatsushima.tokushima.jp
matsushige.tokushima.jp
mima.tokushima.jp
minami.tokushima.jp
miyoshi.tokushima.jp
mugi.tokushima.jp
nakagawa.tokushima.jp
naruto.tokushima.jp
sanagochi.tokushima.jp
shishikui.tokushima.jp
tokushima.tokushima.jp
wajiki.tokushima.jp
adachi.tokyo.jp
akiruno.tokyo.jp
akishima.tokyo.jp
aogashima.tokyo.jp
arakawa.tokyo.jp
bunkyo.tokyo.jp
chiyoda.tokyo.jp
chofu.tokyo.jp
chuo.tokyo.jp
edogawa.tokyo.jp
fuchu.tokyo.jp
fussa.tokyo.jp
hachijo.tokyo.jp
hachioji.tokyo.jp
hamura.tokyo.jp
higashikurume.tokyo.jp
higashimurayama.tokyo.jp
higashiyamato.tokyo.jp
hino.tokyo.jp
hinode.tokyo.jp
hinohara.tokyo.jp
inagi.tokyo.jp
itabashi.tokyo.jp
katsushika.tokyo.jp
kita.tokyo.jp
kiyose.tokyo.jp
kodaira.tokyo.jp
koganei.tokyo.jp
kokubunji.tokyo.jp
komae.tokyo.jp
koto.tokyo.jp
kouzushima.tokyo.jp
kunitachi.tokyo.jp
machida.tokyo.jp
meguro.tokyo.jp
minato.tokyo.jp
mitaka.tokyo.jp
mizuho.tokyo.jp
musashimurayama.tokyo.jp
musashino.tokyo.jp
nakano.tokyo.jp
nerima.tokyo.jp
ogasawara.tokyo.jp
okutama.tokyo.jp
ome.tokyo.jp
oshima.tokyo.jp
ota.tokyo.jp
setagaya.tokyo.jp
shibuya.tokyo.jp
shinagawa.tokyo.jp
shinjuku.tokyo.jp
suginami.tokyo.jp
sumida.tokyo.jp
tachikawa.tokyo.jp
taito.tokyo.jp
tama.tokyo.jp
toshima.tokyo.jp
chizu.tottori.jp
hino.tottori.jp
kawahara.tottori.jp
koge.tottori.jp
kotoura.tottori.jp
misasa.tottori.jp
nanbu.tottori.jp
nichinan.tottori.jp
sakaiminato.tottori.jp
tottori.tottori.jp
wakasa.tottori.jp
yazu.tottori.jp
yonago.tottori.jp
asahi.toyama.jp
fuchu.toyama.jp
fukumitsu.toyama.jp
funahashi.toyama.jp
himi.toyama.jp
imizu.toyama.jp
inami.toyama.jp
johana.toyama.jp
kamiichi.toyama.jp
kurobe.toyama.jp
nakaniikawa.toyama.jp
namerikawa.toyama.jp
nanto.toyama.jp
nyuzen.toyama.jp
oyabe.toyama.jp
taira.toyama.jp
takaoka.toyama.jp
tateyama.toyama.jp
toga.toyama.jp
tonami.toyama.jp
toyama.toyama.jp
unazuki.toyama.jp
uozu.toyama.jp
yamada.toyama.jp
arida.wakayama.jp
aridagawa.wakayama.jp
gobo.wakayama.jp
hashimoto.wakayama.jp
hidaka.wakayama.jp
hirogawa.wakayama.jp
inami.wakayama.jp
iwade.wakayama.jp
kainan.wakayama.jp
kamitonda.wakayama.jp
katsuragi.wakayama.jp
kimino.wakayama.jp
kinokawa.wakayama.jp
kitayama.wakayama.jp
koya.wakayama.jp
koza.wakayama.jp
kozagawa.wakayama.jp
kudoyama.wakayama.jp
kushimoto.wakayama.jp
mihama.wakayama.jp
misato.wakayama.jp
nachikatsuura.wakayama.jp
shingu.wakayama.jp
shirahama.wakayama.jp
taiji.wakayama.jp
tanabe.wakayama.jp
wakayama.wakayama.jp
yuasa.wakayama.jp
yura.wakayama.jp
asahi.yamagata.jp
funagata.yamagata.jp
higashine.yamagata.jp
iide.yamagata.jp
kahoku.yamagata.jp
kaminoyama.yamagata.jp
kaneyama.yamagata.jp
kawanishi.yamagata.jp
mamurogawa.yamagata.jp
mikawa.yamagata.jp
murayama.yamagata.jp
nagai.yamagata.jp
nakayama.yamagata.jp
nanyo.yamagata.jp
nishikawa.yamagata.jp
obanazawa.yamagata.jp
oe.yamagata.jp
oguni.yamagata.jp
ohkura.yamagata.jp
oishida.yamagata.jp
sagae.yamagata.jp
sakata.yamagata.jp
sakegawa.yamagata.jp
shinjo.yamagata.jp
shirataka.yamagata.jp
shonai.yamagata.jp
takahata.yamagata.jp
tendo.yamagata.jp
tozawa.yamagata.jp
tsuruoka.yamagata.jp
yamagata.yamagata.jp
yamanobe.yamagata.jp
yonezawa.yamagata.jp
yuza.yamagata.jp
abu.yamaguchi.jp
hagi.yamaguchi.jp
hikari.yamaguchi.jp
hofu.yamaguchi.jp
iwakuni.yamaguchi.jp
kudamatsu.yamaguchi.jp
mitou.yamaguchi.jp
nagato.yamaguchi.jp
oshima.yamaguchi.jp
shimonoseki.yamaguchi.jp
shunan.yamaguchi.jp
tabuse.yamaguchi.jp
tokuyama.yamaguchi.jp
toyota.yamaguchi.jp
ube.yamaguchi.jp
yuu.yamaguchi.jp
chuo.yamanashi.jp
doshi.yamanashi.jp
fuefuki.yamanashi.jp
fujikawa.yamanashi.jp
fujikawaguchiko.yamanashi.jp
fujiyoshida.yamanashi.jp
hayakawa.yamanashi.jp
hokuto.yamanashi.jp
ichikawamisato.yamanashi.jp
kai.yamanashi.jp
kofu.yamanashi.jp
koshu.yamanashi.jp
kosuge.yamanashi.jp
minami-alps.yamanashi.jp
minobu.yamanashi.jp
nakamichi.yamanashi.jp
nanbu.yamanashi.jp
narusawa.yamanashi.jp
nirasaki.yamanashi.jp
nishikatsura.yamanashi.jp
oshino.yamanashi.jp
otsuki.yamanashi.jp
showa.yamanashi.jp
tabayama.yamanashi.jp
tsuru.yamanashi.jp
uenohara.yamanashi.jp
yamanakako.yamanashi.jp
yamanashi.yamanashi.jp

// ke : http://www.kenic.or.ke/index.php/en/ke-domains/ke-domains
ke
ac.ke
co.ke
go.ke
info.ke
me.ke
mobi.ke
ne.ke
or.ke
sc.ke

// kg : http://www.domain.kg/dmn_n.html
kg
org.kg
net.kg
com.kg
edu.kg
gov.kg
mil.kg

// kh : http://www.mptc.gov.kh/dns_registration.htm
*.kh

// ki : http://www.ki/dns/index.html
ki
edu.ki
biz.ki
net.ki
org.ki
gov.ki
info.ki
com.ki

// km : https://en.wikipedia.org/wiki/.km
// http://www.domaine.km/documents/charte.doc
km
org.km
nom.km
gov.km
prd.km
tm.km
edu.km
mil.km
ass.km
com.km
// These are only mentioned as proposed suggestions at domaine.km, but
// https://en.wikipedia.org/wiki/.km says they're available for registration:
coop.km
asso.km
presse.km
medecin.km
notaires.km
pharmaciens.km
veterinaire.km
gouv.km

// kn : https://en.wikipedia.org/wiki/.kn
// http://www.dot.kn/domainRules.html
kn
net.kn
org.kn
edu.kn
gov.kn

// kp : http://www.kcce.kp/en_index.php
kp
com.kp
edu.kp
gov.kp
org.kp
rep.kp
tra.kp

// kr : https://en.wikipedia.org/wiki/.kr
// see also: http://domain.nida.or.kr/eng/registration.jsp
kr
ac.kr
co.kr
es.kr
go.kr
hs.kr
kg.kr
mil.kr
ms.kr
ne.kr
or.kr
pe.kr
re.kr
sc.kr
// kr geographical names
busan.kr
chungbuk.kr
chungnam.kr
daegu.kr
daejeon.kr
gangwon.kr
gwangju.kr
gyeongbuk.kr
gyeonggi.kr
gyeongnam.kr
incheon.kr
jeju.kr
jeonbuk.kr
jeonnam.kr
seoul.kr
ulsan.kr

// kw : https://www.nic.kw/policies/
// Confirmed by registry <nic.tech@citra.gov.kw>
kw
com.kw
edu.kw
emb.kw
gov.kw
ind.kw
net.kw
org.kw

// ky : http://www.icta.ky/da_ky_reg_dom.php
// Confirmed by registry <kysupport@perimeterusa.com> 2008-06-17
ky
edu.ky
gov.ky
com.ky
org.ky
net.ky

// kz : https://en.wikipedia.org/wiki/.kz
// see also: http://www.nic.kz/rules/index.jsp
kz
org.kz
edu.kz
net.kz
gov.kz
mil.kz
com.kz

// la : https://en.wikipedia.org/wiki/.la
// Submitted by registry <gavin.brown@nic.la>
la
int.la
net.la
info.la
edu.la
gov.la
per.la
com.la
org.la

// lb : https://en.wikipedia.org/wiki/.lb
// Submitted by registry <randy@psg.com>
lb
com.lb
edu.lb
gov.lb
net.lb
org.lb

// lc : https://en.wikipedia.org/wiki/.lc
// see also: http://www.nic.lc/rules.htm
lc
com.lc
net.lc
co.lc
org.lc
edu.lc
gov.lc

// li : https://en.wikipedia.org/wiki/.li
li

// lk : https://www.nic.lk/index.php/domain-registration/lk-domain-naming-structure
lk
gov.lk
sch.lk
net.lk
int.lk
com.lk
org.lk
edu.lk
ngo.lk
soc.lk
web.lk
ltd.lk
assn.lk
grp.lk
hotel.lk
ac.lk

// lr : http://psg.com/dns/lr/lr.txt
// Submitted by registry <randy@psg.com>
lr
com.lr
edu.lr
gov.lr
org.lr
net.lr

// ls : http://www.nic.ls/
// Confirmed by registry <lsadmin@nic.ls>
ls
ac.ls
biz.ls
co.ls
edu.ls
gov.ls
info.ls
net.ls
org.ls
sc.ls

// lt : https://en.wikipedia.org/wiki/.lt
lt
// gov.lt : http://www.gov.lt/index_en.php
gov.lt

// lu : http://www.dns.lu/en/
lu

// lv : http://www.nic.lv/DNS/En/generic.php
lv
com.lv
edu.lv
gov.lv
org.lv
mil.lv
id.lv
net.lv
asn.lv
conf.lv

// ly : http://www.nic.ly/regulations.php
ly
com.ly
net.ly
gov.ly
plc.ly
edu.ly
sch.ly
med.ly
org.ly
id.ly

// ma : https://en.wikipedia.org/wiki/.ma
// http://www.anrt.ma/fr/admin/download/upload/file_fr782.pdf
ma
co.ma
net.ma
gov.ma
org.ma
ac.ma
press.ma

// mc : http://www.nic.mc/
mc
tm.mc
asso.mc

// md : https://en.wikipedia.org/wiki/.md
md

// me : https://en.wikipedia.org/wiki/.me
me
co.me
net.me
org.me
edu.me
ac.me
gov.me
its.me
priv.me

// mg : http://nic.mg/nicmg/?page_id=39
mg
org.mg
nom.mg
gov.mg
prd.mg
tm.mg
edu.mg
mil.mg
com.mg
co.mg

// mh : https://en.wikipedia.org/wiki/.mh
mh

// mil : https://en.wikipedia.org/wiki/.mil
mil

// mk : https://en.wikipedia.org/wiki/.mk
// see also: http://dns.marnet.net.mk/postapka.php
mk
com.mk
org.mk
net.mk
edu.mk
gov.mk
inf.mk
name.mk

// ml : http://www.gobin.info/domainname/ml-template.doc
// see also: https://en.wikipedia.org/wiki/.ml
ml
com.ml
edu.ml
gouv.ml
gov.ml
net.ml
org.ml
presse.ml

// mm : https://en.wikipedia.org/wiki/.mm
*.mm

// mn : https://en.wikipedia.org/wiki/.mn
mn
gov.mn
edu.mn
org.mn

// mo : http://www.monic.net.mo/
mo
com.mo
net.mo
org.mo
edu.mo
gov.mo

// mobi : https://en.wikipedia.org/wiki/.mobi
mobi

// mp : http://www.dot.mp/
// Confirmed by registry <dcamacho@saipan.com> 2008-06-17
mp

// mq : https://en.wikipedia.org/wiki/.mq
mq

// mr : https://en.wikipedia.org/wiki/.mr
mr
gov.mr

// ms : http://www.nic.ms/pdf/MS_Domain_Name_Rules.pdf
ms
com.ms
edu.ms
gov.ms
net.ms
org.ms

// mt : https://www.nic.org.mt/go/policy
// Submitted by registry <help@nic.org.mt>
mt
com.mt
edu.mt
net.mt
org.mt

// mu : https://en.wikipedia.org/wiki/.mu
mu
com.mu
net.mu
org.mu
gov.mu
ac.mu
co.mu
or.mu

// museum : http://about.museum/naming/
// http://index.museum/
museum
academy.museum
agriculture.museum
air.museum
airguard.museum
alabama.museum
alaska.museum
amber.museum
ambulance.museum
american.museum
americana.museum
americanantiques.museum
americanart.museum
amsterdam.museum
and.museum
annefrank.museum
anthro.museum
anthropology.museum
antiques.museum
aquarium.museum
arboretum.museum
archaeological.museum
archaeology.museum
architecture.museum
art.museum
artanddesign.museum
artcenter.museum
artdeco.museum
arteducation.museum
artgallery.museum
arts.museum
artsandcrafts.museum
asmatart.museum
assassination.museum
assisi.museum
association.museum
astronomy.museum
atlanta.museum
austin.museum
australia.museum
automotive.museum
aviation.museum
axis.museum
badajoz.museum
baghdad.museum
bahn.museum
bale.museum
baltimore.museum
barcelona.museum
baseball.museum
basel.museum
baths.museum
bauern.museum
beauxarts.museum
beeldengeluid.museum
bellevue.museum
bergbau.museum
berkeley.museum
berlin.museum
bern.museum
bible.museum
bilbao.museum
bill.museum
birdart.museum
birthplace.museum
bonn.museum
boston.museum
botanical.museum
botanicalgarden.museum
botanicgarden.museum
botany.museum
brandywinevalley.museum
brasil.museum
bristol.museum
british.museum
britishcolumbia.museum
broadcast.museum
brunel.museum
brussel.museum
brussels.museum
bruxelles.museum
building.museum
burghof.museum
bus.museum
bushey.museum
cadaques.museum
california.museum
cambridge.museum
can.museum
canada.museum
capebreton.museum
carrier.museum
cartoonart.museum
casadelamoneda.museum
castle.museum
castres.museum
celtic.museum
center.museum
chattanooga.museum
cheltenham.museum
chesapeakebay.museum
chicago.museum
children.museum
childrens.museum
childrensgarden.museum
chiropractic.museum
chocolate.museum
christiansburg.museum
cincinnati.museum
cinema.museum
circus.museum
civilisation.museum
civilization.museum
civilwar.museum
clinton.museum
clock.museum
coal.museum
coastaldefence.museum
cody.museum
coldwar.museum
collection.museum
colonialwilliamsburg.museum
coloradoplateau.museum
columbia.museum
columbus.museum
communication.museum
communications.museum
community.museum
computer.museum
computerhistory.museum
xn--comunicaes-v6a2o.museum
contemporary.museum
contemporaryart.museum
convent.museum
copenhagen.museum
corporation.museum
xn--correios-e-telecomunicaes-ghc29a.museum
corvette.museum
costume.museum
countryestate.museum
county.museum
crafts.museum
cranbrook.museum
creation.museum
cultural.museum
culturalcenter.museum
culture.museum
cyber.museum
cymru.museum
dali.museum
dallas.museum
database.museum
ddr.museum
decorativearts.museum
delaware.museum
delmenhorst.museum
denmark.museum
depot.museum
design.museum
detroit.museum
dinosaur.museum
discovery.museum
dolls.museum
donostia.museum
durham.museum
eastafrica.museum
eastcoast.museum
education.museum
educational.museum
egyptian.museum
eisenbahn.museum
elburg.museum
elvendrell.museum
embroidery.museum
encyclopedic.museum
england.museum
entomology.museum
environment.museum
environmentalconservation.museum
epilepsy.museum
essex.museum
estate.museum
ethnology.museum
exeter.museum
exhibition.museum
family.museum
farm.museum
farmequipment.museum
farmers.museum
farmstead.museum
field.museum
figueres.museum
filatelia.museum
film.museum
fineart.museum
finearts.museum
finland.museum
flanders.museum
florida.museum
force.museum
fortmissoula.museum
fortworth.museum
foundation.museum
francaise.museum
frankfurt.museum
franziskaner.museum
freemasonry.museum
freiburg.museum
fribourg.museum
frog.museum
fundacio.museum
furniture.museum
gallery.museum
garden.museum
gateway.museum
geelvinck.museum
gemological.museum
geology.museum
georgia.museum
giessen.museum
glas.museum
glass.museum
gorge.museum
grandrapids.museum
graz.museum
guernsey.museum
halloffame.museum
hamburg.museum
handson.museum
harvestcelebration.museum
hawaii.museum
health.museum
heimatunduhren.museum
hellas.museum
helsinki.museum
hembygdsforbund.museum
heritage.museum
histoire.museum
historical.museum
historicalsociety.museum
historichouses.museum
historisch.museum
historisches.museum
history.museum
historyofscience.museum
horology.museum
house.museum
humanities.museum
illustration.museum
imageandsound.museum
indian.museum
indiana.museum
indianapolis.museum
indianmarket.museum
intelligence.museum
interactive.museum
iraq.museum
iron.museum
isleofman.museum
jamison.museum
jefferson.museum
jerusalem.museum
jewelry.museum
jewish.museum
jewishart.museum
jfk.museum
journalism.museum
judaica.museum
judygarland.museum
juedisches.museum
juif.museum
karate.museum
karikatur.museum
kids.museum
koebenhavn.museum
koeln.museum
kunst.museum
kunstsammlung.museum
kunstunddesign.museum
labor.museum
labour.museum
lajolla.museum
lancashire.museum
landes.museum
lans.museum
xn--lns-qla.museum
larsson.museum
lewismiller.museum
lincoln.museum
linz.museum
living.museum
livinghistory.museum
localhistory.museum
london.museum
losangeles.museum
louvre.museum
loyalist.museum
lucerne.museum
luxembourg.museum
luzern.museum
mad.museum
madrid.museum
mallorca.museum
manchester.museum
mansion.museum
mansions.museum
manx.museum
marburg.museum
maritime.museum
maritimo.museum
maryland.museum
marylhurst.museum
media.museum
medical.museum
medizinhistorisches.museum
meeres.museum
memorial.museum
mesaverde.museum
michigan.museum
midatlantic.museum
military.museum
mill.museum
miners.museum
mining.museum
minnesota.museum
missile.museum
missoula.museum
modern.museum
moma.museum
money.museum
monmouth.museum
monticello.museum
montreal.museum
moscow.museum
motorcycle.museum
muenchen.museum
muenster.museum
mulhouse.museum
muncie.museum
museet.museum
museumcenter.museum
museumvereniging.museum
music.museum
national.museum
nationalfirearms.museum
nationalheritage.museum
nativeamerican.museum
naturalhistory.museum
naturalhistorymuseum.museum
naturalsciences.museum
nature.museum
naturhistorisches.museum
natuurwetenschappen.museum
naumburg.museum
naval.museum
nebraska.museum
neues.museum
newhampshire.museum
newjersey.museum
newmexico.museum
newport.museum
newspaper.museum
newyork.museum
niepce.museum
norfolk.museum
north.museum
nrw.museum
nyc.museum
nyny.museum
oceanographic.museum
oceanographique.museum
omaha.museum
online.museum
ontario.museum
openair.museum
oregon.museum
oregontrail.museum
otago.museum
oxford.museum
pacific.museum
paderborn.museum
palace.museum
paleo.museum
palmsprings.museum
panama.museum
paris.museum
pasadena.museum
pharmacy.museum
philadelphia.museum
philadelphiaarea.museum
philately.museum
phoenix.museum
photography.museum
pilots.museum
pittsburgh.museum
planetarium.museum
plantation.museum
plants.museum
plaza.museum
portal.museum
portland.museum
portlligat.museum
posts-and-telecommunications.museum
preservation.museum
presidio.museum
press.museum
project.museum
public.museum
pubol.museum
quebec.museum
railroad.museum
railway.museum
research.museum
resistance.museum
riodejaneiro.museum
rochester.museum
rockart.museum
roma.museum
russia.museum
saintlouis.museum
salem.museum
salvadordali.museum
salzburg.museum
sandiego.museum
sanfrancisco.museum
santabarbara.museum
santacruz.museum
santafe.museum
saskatchewan.museum
satx.museum
savannahga.museum
schlesisches.museum
schoenbrunn.museum
schokoladen.museum
school.museum
schweiz.museum
science.museum
scienceandhistory.museum
scienceandindustry.museum
sciencecenter.museum
sciencecenters.museum
science-fiction.museum
sciencehistory.museum
sciences.museum
sciencesnaturelles.museum
scotland.museum
seaport.museum
settlement.museum
settlers.museum
shell.museum
sherbrooke.museum
sibenik.museum
silk.museum
ski.museum
skole.museum
society.museum
sologne.museum
soundandvision.museum
southcarolina.museum
southwest.museum
space.museum
spy.museum
square.museum
stadt.museum
stalbans.museum
starnberg.museum
state.museum
stateofdelaware.museum
station.museum
steam.museum
steiermark.museum
stjohn.museum
stockholm.museum
stpetersburg.museum
stuttgart.museum
suisse.museum
surgeonshall.museum
surrey.museum
svizzera.museum
sweden.museum
sydney.museum
tank.museum
tcm.museum
technology.museum
telekommunikation.museum
television.museum
texas.museum
textile.museum
theater.museum
time.museum
timekeeping.museum
topology.museum
torino.museum
touch.museum
town.museum
transport.museum
tree.museum
trolley.museum
trust.museum
trustee.museum
uhren.museum
ulm.museum
undersea.museum
university.museum
usa.museum
usantiques.museum
usarts.museum
uscountryestate.museum
usculture.museum
usdecorativearts.museum
usgarden.museum
ushistory.museum
ushuaia.museum
uslivinghistory.museum
utah.museum
uvic.museum
valley.museum
vantaa.museum
versailles.museum
viking.museum
village.museum
virginia.museum
virtual.museum
virtuel.museum
vlaanderen.museum
volkenkunde.museum
wales.museum
wallonie.museum
war.museum
washingtondc.museum
watchandclock.museum
watch-and-clock.museum
western.museum
westfalen.museum
whaling.museum
wildlife.museum
williamsburg.museum
windmill.museum
workshop.museum
york.museum
yorkshire.museum
yosemite.museum
youth.museum
zoological.museum
zoology.museum
xn--9dbhblg6di.museum
xn--h1aegh.museum

// mv : https://en.wikipedia.org/wiki/.mv
// "mv" included because, contra Wikipedia, google.mv exists.
mv
aero.mv
biz.mv
com.mv
coop.mv
edu.mv
gov.mv
info.mv
int.mv
mil.mv
museum.mv
name.mv
net.mv
org.mv
pro.mv

// mw : http://www.registrar.mw/
mw
ac.mw
biz.mw
co.mw
com.mw
coop.mw
edu.mw
gov.mw
int.mw
museum.mw
net.mw
org.mw

// mx : http://www.nic.mx/
// Submitted by registry <farias@nic.mx>
mx
com.mx
org.mx
gob.mx
edu.mx
net.mx

// my : http://www.mynic.my/
// Available strings: https://mynic.my/resources/domains/buying-a-domain/
my
biz.my
com.my
edu.my
gov.my
mil.my
name.my
net.my
org.my

// mz : http://www.uem.mz/
// Submitted by registry <antonio@uem.mz>
mz
ac.mz
adv.mz
co.mz
edu.mz
gov.mz
mil.mz
net.mz
org.mz

// na : http://www.na-nic.com.na/
// http://www.info.na/domain/
na
info.na
pro.na
name.na
school.na
or.na
dr.na
us.na
mx.na
ca.na
in.na
cc.na
tv.na
ws.na
mobi.na
co.na
com.na
org.na

// name : has 2nd-level tlds, but there's no list of them
name

// nc : http://www.cctld.nc/
nc
asso.nc
nom.nc

// ne : https://en.wikipedia.org/wiki/.ne
ne

// net : https://en.wikipedia.org/wiki/.net
net

// nf : https://en.wikipedia.org/wiki/.nf
nf
com.nf
net.nf
per.nf
rec.nf
web.nf
arts.nf
firm.nf
info.nf
other.nf
store.nf

// ng : http://www.nira.org.ng/index.php/join-us/register-ng-domain/189-nira-slds
ng
com.ng
edu.ng
gov.ng
i.ng
mil.ng
mobi.ng
name.ng
net.ng
org.ng
sch.ng

// ni : http://www.nic.ni/
ni
ac.ni
biz.ni
co.ni
com.ni
edu.ni
gob.ni
in.ni
info.ni
int.ni
mil.ni
net.ni
nom.ni
org.ni
web.ni

// nl : https://en.wikipedia.org/wiki/.nl
//      https://www.sidn.nl/
//      ccTLD for the Netherlands
nl

// no : https://www.norid.no/en/om-domenenavn/regelverk-for-no/
// Norid geographical second level domains : https://www.norid.no/en/om-domenenavn/regelverk-for-no/vedlegg-b/
// Norid category second level domains : https://www.norid.no/en/om-domenenavn/regelverk-for-no/vedlegg-c/
// Norid category second-level domains managed by parties other than Norid : https://www.norid.no/en/om-domenenavn/regelverk-for-no/vedlegg-d/
// RSS feed: https://teknisk.norid.no/en/feed/
no
// Norid category second level domains : https://www.norid.no/en/om-domenenavn/regelverk-for-no/vedlegg-c/
fhs.no
vgs.no
fylkesbibl.no
folkebibl.no
museum.no
idrett.no
priv.no
// Norid category second-level domains managed by parties other than Norid : https://www.norid.no/en/om-domenenavn/regelverk-for-no/vedlegg-d/
mil.no
stat.no
dep.no
kommune.no
herad.no
// Norid geographical second level domains : https://www.norid.no/en/om-domenenavn/regelverk-for-no/vedlegg-b/
// counties
aa.no
ah.no
bu.no
fm.no
hl.no
hm.no
jan-mayen.no
mr.no
nl.no
nt.no
of.no
ol.no
oslo.no
rl.no
sf.no
st.no
svalbard.no
tm.no
tr.no
va.no
vf.no
// primary and lower secondary schools per county
gs.aa.no
gs.ah.no
gs.bu.no
gs.fm.no
gs.hl.no
gs.hm.no
gs.jan-mayen.no
gs.mr.no
gs.nl.no
gs.nt.no
gs.of.no
gs.ol.no
gs.oslo.no
gs.rl.no
gs.sf.no
gs.st.no
gs.svalbard.no
gs.tm.no
gs.tr.no
gs.va.no
gs.vf.no
// cities
akrehamn.no
xn--krehamn-dxa.no
algard.no
xn--lgrd-poac.no
arna.no
brumunddal.no
bryne.no
bronnoysund.no
xn--brnnysund-m8ac.no
drobak.no
xn--drbak-wua.no
egersund.no
fetsund.no
floro.no
xn--flor-jra.no
fredrikstad.no
hokksund.no
honefoss.no
xn--hnefoss-q1a.no
jessheim.no
jorpeland.no
xn--jrpeland-54a.no
kirkenes.no
kopervik.no
krokstadelva.no
langevag.no
xn--langevg-jxa.no
leirvik.no
mjondalen.no
xn--mjndalen-64a.no
mo-i-rana.no
mosjoen.no
xn--mosjen-eya.no
nesoddtangen.no
orkanger.no
osoyro.no
xn--osyro-wua.no
raholt.no
xn--rholt-mra.no
sandnessjoen.no
xn--sandnessjen-ogb.no
skedsmokorset.no
slattum.no
spjelkavik.no
stathelle.no
stavern.no
stjordalshalsen.no
xn--stjrdalshalsen-sqb.no
tananger.no
tranby.no
vossevangen.no
// communities
afjord.no
xn--fjord-lra.no
agdenes.no
al.no
xn--l-1fa.no
alesund.no
xn--lesund-hua.no
alstahaug.no
alta.no
xn--lt-liac.no
alaheadju.no
xn--laheadju-7ya.no
alvdal.no
amli.no
xn--mli-tla.no
amot.no
xn--mot-tla.no
andebu.no
andoy.no
xn--andy-ira.no
andasuolo.no
ardal.no
xn--rdal-poa.no
aremark.no
arendal.no
xn--s-1fa.no
aseral.no
xn--seral-lra.no
asker.no
askim.no
askvoll.no
askoy.no
xn--asky-ira.no
asnes.no
xn--snes-poa.no
audnedaln.no
aukra.no
aure.no
aurland.no
aurskog-holand.no
xn--aurskog-hland-jnb.no
austevoll.no
austrheim.no
averoy.no
xn--avery-yua.no
balestrand.no
ballangen.no
balat.no
xn--blt-elab.no
balsfjord.no
bahccavuotna.no
xn--bhccavuotna-k7a.no
bamble.no
bardu.no
beardu.no
beiarn.no
bajddar.no
xn--bjddar-pta.no
baidar.no
xn--bidr-5nac.no
berg.no
bergen.no
berlevag.no
xn--berlevg-jxa.no
bearalvahki.no
xn--bearalvhki-y4a.no
bindal.no
birkenes.no
bjarkoy.no
xn--bjarky-fya.no
bjerkreim.no
bjugn.no
bodo.no
xn--bod-2na.no
badaddja.no
xn--bdddj-mrabd.no
budejju.no
bokn.no
bremanger.no
bronnoy.no
xn--brnny-wuac.no
bygland.no
bykle.no
barum.no
xn--brum-voa.no
bo.telemark.no
xn--b-5ga.telemark.no
bo.nordland.no
xn--b-5ga.nordland.no
bievat.no
xn--bievt-0qa.no
bomlo.no
xn--bmlo-gra.no
batsfjord.no
xn--btsfjord-9za.no
bahcavuotna.no
xn--bhcavuotna-s4a.no
dovre.no
drammen.no
drangedal.no
dyroy.no
xn--dyry-ira.no
donna.no
xn--dnna-gra.no
eid.no
eidfjord.no
eidsberg.no
eidskog.no
eidsvoll.no
eigersund.no
elverum.no
enebakk.no
engerdal.no
etne.no
etnedal.no
evenes.no
evenassi.no
xn--eveni-0qa01ga.no
evje-og-hornnes.no
farsund.no
fauske.no
fuossko.no
fuoisku.no
fedje.no
fet.no
finnoy.no
xn--finny-yua.no
fitjar.no
fjaler.no
fjell.no
flakstad.no
flatanger.no
flekkefjord.no
flesberg.no
flora.no
fla.no
xn--fl-zia.no
folldal.no
forsand.no
fosnes.no
frei.no
frogn.no
froland.no
frosta.no
frana.no
xn--frna-woa.no
froya.no
xn--frya-hra.no
fusa.no
fyresdal.no
forde.no
xn--frde-gra.no
gamvik.no
gangaviika.no
xn--ggaviika-8ya47h.no
gaular.no
gausdal.no
gildeskal.no
xn--gildeskl-g0a.no
giske.no
gjemnes.no
gjerdrum.no
gjerstad.no
gjesdal.no
gjovik.no
xn--gjvik-wua.no
gloppen.no
gol.no
gran.no
grane.no
granvin.no
gratangen.no
grimstad.no
grong.no
kraanghke.no
xn--kranghke-b0a.no
grue.no
gulen.no
hadsel.no
halden.no
halsa.no
hamar.no
hamaroy.no
habmer.no
xn--hbmer-xqa.no
hapmir.no
xn--hpmir-xqa.no
hammerfest.no
hammarfeasta.no
xn--hmmrfeasta-s4ac.no
haram.no
hareid.no
harstad.no
hasvik.no
aknoluokta.no
xn--koluokta-7ya57h.no
hattfjelldal.no
aarborte.no
haugesund.no
hemne.no
hemnes.no
hemsedal.no
heroy.more-og-romsdal.no
xn--hery-ira.xn--mre-og-romsdal-qqb.no
heroy.nordland.no
xn--hery-ira.nordland.no
hitra.no
hjartdal.no
hjelmeland.no
hobol.no
xn--hobl-ira.no
hof.no
hol.no
hole.no
holmestrand.no
holtalen.no
xn--holtlen-hxa.no
hornindal.no
horten.no
hurdal.no
hurum.no
hvaler.no
hyllestad.no
hagebostad.no
xn--hgebostad-g3a.no
hoyanger.no
xn--hyanger-q1a.no
hoylandet.no
xn--hylandet-54a.no
ha.no
xn--h-2fa.no
ibestad.no
inderoy.no
xn--indery-fya.no
iveland.no
jevnaker.no
jondal.no
jolster.no
xn--jlster-bya.no
karasjok.no
karasjohka.no
xn--krjohka-hwab49j.no
karlsoy.no
galsa.no
xn--gls-elac.no
karmoy.no
xn--karmy-yua.no
kautokeino.no
guovdageaidnu.no
klepp.no
klabu.no
xn--klbu-woa.no
kongsberg.no
kongsvinger.no
kragero.no
xn--krager-gya.no
kristiansand.no
kristiansund.no
krodsherad.no
xn--krdsherad-m8a.no
kvalsund.no
rahkkeravju.no
xn--rhkkervju-01af.no
kvam.no
kvinesdal.no
kvinnherad.no
kviteseid.no
kvitsoy.no
xn--kvitsy-fya.no
kvafjord.no
xn--kvfjord-nxa.no
giehtavuoatna.no
kvanangen.no
xn--kvnangen-k0a.no
navuotna.no
xn--nvuotna-hwa.no
kafjord.no
xn--kfjord-iua.no
gaivuotna.no
xn--givuotna-8ya.no
larvik.no
lavangen.no
lavagis.no
loabat.no
xn--loabt-0qa.no
lebesby.no
davvesiida.no
leikanger.no
leirfjord.no
leka.no
leksvik.no
lenvik.no
leangaviika.no
xn--leagaviika-52b.no
lesja.no
levanger.no
lier.no
lierne.no
lillehammer.no
lillesand.no
lindesnes.no
lindas.no
xn--linds-pra.no
lom.no
loppa.no
lahppi.no
xn--lhppi-xqa.no
lund.no
lunner.no
luroy.no
xn--lury-ira.no
luster.no
lyngdal.no
lyngen.no
ivgu.no
lardal.no
lerdal.no
xn--lrdal-sra.no
lodingen.no
xn--ldingen-q1a.no
lorenskog.no
xn--lrenskog-54a.no
loten.no
xn--lten-gra.no
malvik.no
masoy.no
xn--msy-ula0h.no
muosat.no
xn--muost-0qa.no
mandal.no
marker.no
marnardal.no
masfjorden.no
meland.no
meldal.no
melhus.no
meloy.no
xn--mely-ira.no
meraker.no
xn--merker-kua.no
moareke.no
xn--moreke-jua.no
midsund.no
midtre-gauldal.no
modalen.no
modum.no
molde.no
moskenes.no
moss.no
mosvik.no
malselv.no
xn--mlselv-iua.no
malatvuopmi.no
xn--mlatvuopmi-s4a.no
namdalseid.no
aejrie.no
namsos.no
namsskogan.no
naamesjevuemie.no
xn--nmesjevuemie-tcba.no
laakesvuemie.no
nannestad.no
narvik.no
narviika.no
naustdal.no
nedre-eiker.no
nes.akershus.no
nes.buskerud.no
nesna.no
nesodden.no
nesseby.no
unjarga.no
xn--unjrga-rta.no
nesset.no
nissedal.no
nittedal.no
nord-aurdal.no
nord-fron.no
nord-odal.no
norddal.no
nordkapp.no
davvenjarga.no
xn--davvenjrga-y4a.no
nordre-land.no
nordreisa.no
raisa.no
xn--risa-5na.no
nore-og-uvdal.no
notodden.no
naroy.no
xn--nry-yla5g.no
notteroy.no
xn--nttery-byae.no
odda.no
oksnes.no
xn--ksnes-uua.no
oppdal.no
oppegard.no
xn--oppegrd-ixa.no
orkdal.no
orland.no
xn--rland-uua.no
orskog.no
xn--rskog-uua.no
orsta.no
xn--rsta-fra.no
os.hedmark.no
os.hordaland.no
osen.no
osteroy.no
xn--ostery-fya.no
ostre-toten.no
xn--stre-toten-zcb.no
overhalla.no
ovre-eiker.no
xn--vre-eiker-k8a.no
oyer.no
xn--yer-zna.no
oygarden.no
xn--ygarden-p1a.no
oystre-slidre.no
xn--ystre-slidre-ujb.no
porsanger.no
porsangu.no
xn--porsgu-sta26f.no
porsgrunn.no
radoy.no
xn--rady-ira.no
rakkestad.no
rana.no
ruovat.no
randaberg.no
rauma.no
rendalen.no
rennebu.no
rennesoy.no
xn--rennesy-v1a.no
rindal.no
ringebu.no
ringerike.no
ringsaker.no
rissa.no
risor.no
xn--risr-ira.no
roan.no
rollag.no
rygge.no
ralingen.no
xn--rlingen-mxa.no
rodoy.no
xn--rdy-0nab.no
romskog.no
xn--rmskog-bya.no
roros.no
xn--rros-gra.no
rost.no
xn--rst-0na.no
royken.no
xn--ryken-vua.no
royrvik.no
xn--ryrvik-bya.no
rade.no
xn--rde-ula.no
salangen.no
siellak.no
saltdal.no
salat.no
xn--slt-elab.no
xn--slat-5na.no
samnanger.no
sande.more-og-romsdal.no
sande.xn--mre-og-romsdal-qqb.no
sande.vestfold.no
sandefjord.no
sandnes.no
sandoy.no
xn--sandy-yua.no
sarpsborg.no
sauda.no
sauherad.no
sel.no
selbu.no
selje.no
seljord.no
sigdal.no
siljan.no
sirdal.no
skaun.no
skedsmo.no
ski.no
skien.no
skiptvet.no
skjervoy.no
xn--skjervy-v1a.no
skierva.no
xn--skierv-uta.no
skjak.no
xn--skjk-soa.no
skodje.no
skanland.no
xn--sknland-fxa.no
skanit.no
xn--sknit-yqa.no
smola.no
xn--smla-hra.no
snillfjord.no
snasa.no
xn--snsa-roa.no
snoasa.no
snaase.no
xn--snase-nra.no
sogndal.no
sokndal.no
sola.no
solund.no
songdalen.no
sortland.no
spydeberg.no
stange.no
stavanger.no
steigen.no
steinkjer.no
stjordal.no
xn--stjrdal-s1a.no
stokke.no
stor-elvdal.no
stord.no
stordal.no
storfjord.no
omasvuotna.no
strand.no
stranda.no
stryn.no
sula.no
suldal.no
sund.no
sunndal.no
surnadal.no
sveio.no
svelvik.no
sykkylven.no
sogne.no
xn--sgne-gra.no
somna.no
xn--smna-gra.no
sondre-land.no
xn--sndre-land-0cb.no
sor-aurdal.no
xn--sr-aurdal-l8a.no
sor-fron.no
xn--sr-fron-q1a.no
sor-odal.no
xn--sr-odal-q1a.no
sor-varanger.no
xn--sr-varanger-ggb.no
matta-varjjat.no
xn--mtta-vrjjat-k7af.no
sorfold.no
xn--srfold-bya.no
sorreisa.no
xn--srreisa-q1a.no
sorum.no
xn--srum-gra.no
tana.no
deatnu.no
time.no
tingvoll.no
tinn.no
tjeldsund.no
dielddanuorri.no
tjome.no
xn--tjme-hra.no
tokke.no
tolga.no
torsken.no
tranoy.no
xn--trany-yua.no
tromso.no
xn--troms-zua.no
tromsa.no
romsa.no
trondheim.no
troandin.no
trysil.no
trana.no
xn--trna-woa.no
trogstad.no
xn--trgstad-r1a.no
tvedestrand.no
tydal.no
tynset.no
tysfjord.no
divtasvuodna.no
divttasvuotna.no
tysnes.no
tysvar.no
xn--tysvr-vra.no
tonsberg.no
xn--tnsberg-q1a.no
ullensaker.no
ullensvang.no
ulvik.no
utsira.no
vadso.no
xn--vads-jra.no
cahcesuolo.no
xn--hcesuolo-7ya35b.no
vaksdal.no
valle.no
vang.no
vanylven.no
vardo.no
xn--vard-jra.no
varggat.no
xn--vrggt-xqad.no
vefsn.no
vaapste.no
vega.no
vegarshei.no
xn--vegrshei-c0a.no
vennesla.no
verdal.no
verran.no
vestby.no
vestnes.no
vestre-slidre.no
vestre-toten.no
vestvagoy.no
xn--vestvgy-ixa6o.no
vevelstad.no
vik.no
vikna.no
vindafjord.no
volda.no
voss.no
varoy.no
xn--vry-yla5g.no
vagan.no
xn--vgan-qoa.no
voagat.no
vagsoy.no
xn--vgsy-qoa0j.no
vaga.no
xn--vg-yiab.no
valer.ostfold.no
xn--vler-qoa.xn--stfold-9xa.no
valer.hedmark.no
xn--vler-qoa.hedmark.no

// np : http://www.mos.com.np/register.html
*.np

// nr : http://cenpac.net.nr/dns/index.html
// Submitted by registry <technician@cenpac.net.nr>
nr
biz.nr
info.nr
gov.nr
edu.nr
org.nr
net.nr
com.nr

// nu : https://en.wikipedia.org/wiki/.nu
nu

// nz : https://en.wikipedia.org/wiki/.nz
// Submitted by registry <jay@nzrs.net.nz>
nz
ac.nz
co.nz
cri.nz
geek.nz
gen.nz
govt.nz
health.nz
iwi.nz
kiwi.nz
maori.nz
mil.nz
xn--mori-qsa.nz
net.nz
org.nz
parliament.nz
school.nz

// om : https://en.wikipedia.org/wiki/.om
om
co.om
com.om
edu.om
gov.om
med.om
museum.om
net.om
org.om
pro.om

// onion : https://tools.ietf.org/html/rfc7686
onion

// org : https://en.wikipedia.org/wiki/.org
org

// pa : http://www.nic.pa/
// Some additional second level "domains" resolve directly as hostnames, such as
// pannet.pa, so we add a rule for "pa".
pa
ac.pa
gob.pa
com.pa
org.pa
sld.pa
edu.pa
net.pa
ing.pa
abo.pa
med.pa
nom.pa

// pe : https://www.nic.pe/InformeFinalComision.pdf
pe
edu.pe
gob.pe
nom.pe
mil.pe
org.pe
com.pe
net.pe

// pf : http://www.gobin.info/domainname/formulaire-pf.pdf
pf
com.pf
org.pf
edu.pf

// pg : https://en.wikipedia.org/wiki/.pg
*.pg

// ph : http://www.domains.ph/FAQ2.asp
// Submitted by registry <jed@email.com.ph>
ph
com.ph
net.ph
org.ph
gov.ph
edu.ph
ngo.ph
mil.ph
i.ph

// pk : http://pk5.pknic.net.pk/pk5/msgNamepk.PK
pk
com.pk
net.pk
edu.pk
org.pk
fam.pk
biz.pk
web.pk
gov.pk
gob.pk
gok.pk
gon.pk
gop.pk
gos.pk
info.pk

// pl http://www.dns.pl/english/index.html
// Submitted by registry
pl
com.pl
net.pl
org.pl
// pl functional domains (http://www.dns.pl/english/index.html)
aid.pl
agro.pl
atm.pl
auto.pl
biz.pl
edu.pl
gmina.pl
gsm.pl
info.pl
mail.pl
miasta.pl
media.pl
mil.pl
nieruchomosci.pl
nom.pl
pc.pl
powiat.pl
priv.pl
realestate.pl
rel.pl
sex.pl
shop.pl
sklep.pl
sos.pl
szkola.pl
targi.pl
tm.pl
tourism.pl
travel.pl
turystyka.pl
// Government domains
gov.pl
ap.gov.pl
ic.gov.pl
is.gov.pl
us.gov.pl
kmpsp.gov.pl
kppsp.gov.pl
kwpsp.gov.pl
psp.gov.pl
wskr.gov.pl
kwp.gov.pl
mw.gov.pl
ug.gov.pl
um.gov.pl
umig.gov.pl
ugim.gov.pl
upow.gov.pl
uw.gov.pl
starostwo.gov.pl
pa.gov.pl
po.gov.pl
psse.gov.pl
pup.gov.pl
rzgw.gov.pl
sa.gov.pl
so.gov.pl
sr.gov.pl
wsa.gov.pl
sko.gov.pl
uzs.gov.pl
wiih.gov.pl
winb.gov.pl
pinb.gov.pl
wios.gov.pl
witd.gov.pl
wzmiuw.gov.pl
piw.gov.pl
wiw.gov.pl
griw.gov.pl
wif.gov.pl
oum.gov.pl
sdn.gov.pl
zp.gov.pl
uppo.gov.pl
mup.gov.pl
wuoz.gov.pl
konsulat.gov.pl
oirm.gov.pl
// pl regional domains (http://www.dns.pl/english/index.html)
augustow.pl
babia-gora.pl
bedzin.pl
beskidy.pl
bialowieza.pl
bialystok.pl
bielawa.pl
bieszczady.pl
boleslawiec.pl
bydgoszcz.pl
bytom.pl
cieszyn.pl
czeladz.pl
czest.pl
dlugoleka.pl
elblag.pl
elk.pl
glogow.pl
gniezno.pl
gorlice.pl
grajewo.pl
ilawa.pl
jaworzno.pl
jelenia-gora.pl
jgora.pl
kalisz.pl
kazimierz-dolny.pl
karpacz.pl
kartuzy.pl
kaszuby.pl
katowice.pl
kepno.pl
ketrzyn.pl
klodzko.pl
kobierzyce.pl
kolobrzeg.pl
konin.pl
konskowola.pl
kutno.pl
lapy.pl
lebork.pl
legnica.pl
lezajsk.pl
limanowa.pl
lomza.pl
lowicz.pl
lubin.pl
lukow.pl
malbork.pl
malopolska.pl
mazowsze.pl
mazury.pl
mielec.pl
mielno.pl
mragowo.pl
naklo.pl
nowaruda.pl
nysa.pl
olawa.pl
olecko.pl
olkusz.pl
olsztyn.pl
opoczno.pl
opole.pl
ostroda.pl
ostroleka.pl
ostrowiec.pl
ostrowwlkp.pl
pila.pl
pisz.pl
podhale.pl
podlasie.pl
polkowice.pl
pomorze.pl
pomorskie.pl
prochowice.pl
pruszkow.pl
przeworsk.pl
pulawy.pl
radom.pl
rawa-maz.pl
rybnik.pl
rzeszow.pl
sanok.pl
sejny.pl
slask.pl
slupsk.pl
sosnowiec.pl
stalowa-wola.pl
skoczow.pl
starachowice.pl
stargard.pl
suwalki.pl
swidnica.pl
swiebodzin.pl
swinoujscie.pl
szczecin.pl
szczytno.pl
tarnobrzeg.pl
tgory.pl
turek.pl
tychy.pl
ustka.pl
walbrzych.pl
warmia.pl
warszawa.pl
waw.pl
wegrow.pl
wielun.pl
wlocl.pl
wloclawek.pl
wodzislaw.pl
wolomin.pl
wroclaw.pl
zachpomor.pl
zagan.pl
zarow.pl
zgora.pl
zgorzelec.pl

// pm : http://www.afnic.fr/medias/documents/AFNIC-naming-policy2012.pdf
pm

// pn : http://www.government.pn/PnRegistry/policies.htm
pn
gov.pn
co.pn
org.pn
edu.pn
net.pn

// post : https://en.wikipedia.org/wiki/.post
post

// pr : http://www.nic.pr/index.asp?f=1
pr
com.pr
net.pr
org.pr
gov.pr
edu.pr
isla.pr
pro.pr
biz.pr
info.pr
name.pr
// these aren't mentioned on nic.pr, but on https://en.wikipedia.org/wiki/.pr
est.pr
prof.pr
ac.pr

// pro : http://registry.pro/get-pro
pro
aaa.pro
aca.pro
acct.pro
avocat.pro
bar.pro
cpa.pro
eng.pro
jur.pro
law.pro
med.pro
recht.pro

// ps : https://en.wikipedia.org/wiki/.ps
// http://www.nic.ps/registration/policy.html#reg
ps
edu.ps
gov.ps
sec.ps
plo.ps
com.ps
org.ps
net.ps

// pt : http://online.dns.pt/dns/start_dns
pt
net.pt
gov.pt
org.pt
edu.pt
int.pt
publ.pt
com.pt
nome.pt

// pw : https://en.wikipedia.org/wiki/.pw
pw
co.pw
ne.pw
or.pw
ed.pw
go.pw
belau.pw

// py : http://www.nic.py/pautas.html#seccion_9
// Submitted by registry
py
com.py
coop.py
edu.py
gov.py
mil.py
net.py
org.py

// qa : http://domains.qa/en/
qa
com.qa
edu.qa
gov.qa
mil.qa
name.qa
net.qa
org.qa
sch.qa

// re : http://www.afnic.re/obtenir/chartes/nommage-re/annexe-descriptifs
re
asso.re
com.re
nom.re

// ro : http://www.rotld.ro/
ro
arts.ro
com.ro
firm.ro
info.ro
nom.ro
nt.ro
org.ro
rec.ro
store.ro
tm.ro
www.ro

// rs : https://www.rnids.rs/en/domains/national-domains
rs
ac.rs
co.rs
edu.rs
gov.rs
in.rs
org.rs

// ru : https://cctld.ru/files/pdf/docs/en/rules_ru-rf.pdf
// Submitted by George Georgievsky <gug@cctld.ru>
ru

// rw : https://www.ricta.org.rw/sites/default/files/resources/registry_registrar_contract_0.pdf
rw
ac.rw
co.rw
coop.rw
gov.rw
mil.rw
net.rw
org.rw

// sa : http://www.nic.net.sa/
sa
com.sa
net.sa
org.sa
gov.sa
med.sa
pub.sa
edu.sa
sch.sa

// sb : http://www.sbnic.net.sb/
// Submitted by registry <lee.humphries@telekom.com.sb>
sb
com.sb
edu.sb
gov.sb
net.sb
org.sb

// sc : http://www.nic.sc/
sc
com.sc
gov.sc
net.sc
org.sc
edu.sc

// sd : http://www.isoc.sd/sudanic.isoc.sd/billing_pricing.htm
// Submitted by registry <admin@isoc.sd>
sd
com.sd
net.sd
org.sd
edu.sd
med.sd
tv.sd
gov.sd
info.sd

// se : https://en.wikipedia.org/wiki/.se
// Submitted by registry <patrik.wallstrom@iis.se>
se
a.se
ac.se
b.se
bd.se
brand.se
c.se
d.se
e.se
f.se
fh.se
fhsk.se
fhv.se
g.se
h.se
i.se
k.se
komforb.se
kommunalforbund.se
komvux.se
l.se
lanbib.se
m.se
n.se
naturbruksgymn.se
o.se
org.se
p.se
parti.se
pp.se
press.se
r.se
s.se
t.se
tm.se
u.se
w.se
x.se
y.se
z.se

// sg : http://www.nic.net.sg/page/registration-policies-procedures-and-guidelines
sg
com.sg
net.sg
org.sg
gov.sg
edu.sg
per.sg

// sh : http://www.nic.sh/registrar.html
sh
com.sh
net.sh
gov.sh
org.sh
mil.sh

// si : https://en.wikipedia.org/wiki/.si
si

// sj : No registrations at this time.
// Submitted by registry <jarle@uninett.no>
sj

// sk : https://en.wikipedia.org/wiki/.sk
// list of 2nd level domains ?
sk

// sl : http://www.nic.sl
// Submitted by registry <adam@neoip.com>
sl
com.sl
net.sl
edu.sl
gov.sl
org.sl

// sm : https://en.wikipedia.org/wiki/.sm
sm

// sn : https://en.wikipedia.org/wiki/.sn
sn
art.sn
com.sn
edu.sn
gouv.sn
org.sn
perso.sn
univ.sn

// so : http://sonic.so/policies/
so
com.so
edu.so
gov.so
me.so
net.so
org.so

// sr : https://en.wikipedia.org/wiki/.sr
sr

// ss : https://registry.nic.ss/
// Submitted by registry <technical@nic.ss>
ss
biz.ss
com.ss
edu.ss
gov.ss
me.ss
net.ss
org.ss
sch.ss

// st : http://www.nic.st/html/policyrules/
st
co.st
com.st
consulado.st
edu.st
embaixada.st
mil.st
net.st
org.st
principe.st
saotome.st
store.st

// su : https://en.wikipedia.org/wiki/.su
su

// sv : http://www.svnet.org.sv/niveldos.pdf
sv
com.sv
edu.sv
gob.sv
org.sv
red.sv

// sx : https://en.wikipedia.org/wiki/.sx
// Submitted by registry <jcvignes@openregistry.com>
sx
gov.sx

// sy : https://en.wikipedia.org/wiki/.sy
// see also: http://www.gobin.info/domainname/sy.doc
sy
edu.sy
gov.sy
net.sy
mil.sy
com.sy
org.sy

// sz : https://en.wikipedia.org/wiki/.sz
// http://www.sispa.org.sz/
sz
co.sz
ac.sz
org.sz

// tc : https://en.wikipedia.org/wiki/.tc
tc

// td : https://en.wikipedia.org/wiki/.td
td

// tel: https://en.wikipedia.org/wiki/.tel
// http://www.telnic.org/
tel

// tf : https://en.wikipedia.org/wiki/.tf
tf

// tg : https://en.wikipedia.org/wiki/.tg
// http://www.nic.tg/
tg

// th : https://en.wikipedia.org/wiki/.th
// Submitted by registry <krit@thains.co.th>
th
ac.th
co.th
go.th
in.th
mi.th
net.th
or.th

// tj : http://www.nic.tj/policy.html
tj
ac.tj
biz.tj
co.tj
com.tj
edu.tj
go.tj
gov.tj
int.tj
mil.tj
name.tj
net.tj
nic.tj
org.tj
test.tj
web.tj

// tk : https://en.wikipedia.org/wiki/.tk
tk

// tl : https://en.wikipedia.org/wiki/.tl
tl
gov.tl

// tm : http://www.nic.tm/local.html
tm
com.tm
co.tm
org.tm
net.tm
nom.tm
gov.tm
mil.tm
edu.tm

// tn : https://en.wikipedia.org/wiki/.tn
// http://whois.ati.tn/
tn
com.tn
ens.tn
fin.tn
gov.tn
ind.tn
intl.tn
nat.tn
net.tn
org.tn
info.tn
perso.tn
tourism.tn
edunet.tn
rnrt.tn
rns.tn
rnu.tn
mincom.tn
agrinet.tn
defense.tn
turen.tn

// to : https://en.wikipedia.org/wiki/.to
// Submitted by registry <egullich@colo.to>
to
com.to
gov.to
net.to
org.to
edu.to
mil.to

// tr : https://nic.tr/
// https://nic.tr/forms/eng/policies.pdf
// https://nic.tr/index.php?USRACTN=PRICELST
tr
av.tr
bbs.tr
bel.tr
biz.tr
com.tr
dr.tr
edu.tr
gen.tr
gov.tr
info.tr
mil.tr
k12.tr
kep.tr
name.tr
net.tr
org.tr
pol.tr
tel.tr
tsk.tr
tv.tr
web.tr
// Used by Northern Cyprus
nc.tr
// Used by government agencies of Northern Cyprus
gov.nc.tr

// tt : http://www.nic.tt/
tt
co.tt
com.tt
org.tt
net.tt
biz.tt
info.tt
pro.tt
int.tt
coop.tt
jobs.tt
mobi.tt
travel.tt
museum.tt
aero.tt
name.tt
gov.tt
edu.tt

// tv : https://en.wikipedia.org/wiki/.tv
// Not listing any 2LDs as reserved since none seem to exist in practice,
// Wikipedia notwithstanding.
tv

// tw : https://en.wikipedia.org/wiki/.tw
tw
edu.tw
gov.tw
mil.tw
com.tw
net.tw
org.tw
idv.tw
game.tw
ebiz.tw
club.tw
xn--zf0ao64a.tw
xn--uc0atv.tw
xn--czrw28b.tw

// tz : http://www.tznic.or.tz/index.php/domains
// Submitted by registry <manager@tznic.or.tz>
tz
ac.tz
co.tz
go.tz
hotel.tz
info.tz
me.tz
mil.tz
mobi.tz
ne.tz
or.tz
sc.tz
tv.tz

// ua : https://hostmaster.ua/policy/?ua
// Submitted by registry <dk@cctld.ua>
ua
// ua 2LD
com.ua
edu.ua
gov.ua
in.ua
net.ua
org.ua
// ua geographic names
// https://hostmaster.ua/2ld/
cherkassy.ua
cherkasy.ua
chernigov.ua
chernihiv.ua
chernivtsi.ua
chernovtsy.ua
ck.ua
cn.ua
cr.ua
crimea.ua
cv.ua
dn.ua
dnepropetrovsk.ua
dnipropetrovsk.ua
donetsk.ua
dp.ua
if.ua
ivano-frankivsk.ua
kh.ua
kharkiv.ua
kharkov.ua
kherson.ua
khmelnitskiy.ua
khmelnytskyi.ua
kiev.ua
kirovograd.ua
km.ua
kr.ua
krym.ua
ks.ua
kv.ua
kyiv.ua
lg.ua
lt.ua
lugansk.ua
lutsk.ua
lv.ua
lviv.ua
mk.ua
mykolaiv.ua
nikolaev.ua
od.ua
odesa.ua
odessa.ua
pl.ua
poltava.ua
rivne.ua
rovno.ua
rv.ua
sb.ua
sebastopol.ua
sevastopol.ua
sm.ua
sumy.ua
te.ua
ternopil.ua
uz.ua
uzhgorod.ua
vinnica.ua
vinnytsia.ua
vn.ua
volyn.ua
yalta.ua
zaporizhzhe.ua
zaporizhzhia.ua
zhitomir.ua
zhytomyr.ua
zp.ua
zt.ua

// ug : https://www.registry.co.ug/
ug
co.ug
or.ug
ac.ug
sc.ug
go.ug
ne.ug
com.ug
org.ug

// uk : https://en.wikipedia.org/wiki/.uk
// Submitted by registry <Michael.Daly@nominet.org.uk>
uk
ac.uk
co.uk
gov.uk
ltd.uk
me.uk
net.uk
nhs.uk
org.uk
plc.uk
police.uk
*.sch.uk

// us : https://en.wikipedia.org/wiki/.us
us
dni.us
fed.us
isa.us
kids.us
nsn.us
// us geographic names
ak.us
al.us
ar.us
as.us
az.us
ca.us
co.us
ct.us
dc.us
de.us
fl.us
ga.us
gu.us
hi.us
ia.us
id.us
il.us
in.us
ks.us
ky.us
la.us
ma.us
md.us
me.us
mi.us
mn.us
mo.us
ms.us
mt.us
nc.us
nd.us
ne.us
nh.us
nj.us
nm.us
nv.us
ny.us
oh.us
ok.us
or.us
pa.us
pr.us
ri.us
sc.us
sd.us
tn.us
tx.us
ut.us
vi.us
vt.us
va.us
wa.us
wi.us
wv.us
wy.us
// The registrar notes several more specific domains available in each state,
// such as state.*.us, dst.*.us, etc., but resolution of these is somewhat
// haphazard; in some states these domains resolve as addresses, while in others
// only subdomains are available, or even nothing at all. We include the
// most common ones where it's clear that different sites are different
// entities.
k12.ak.us
k12.al.us
k12.ar.us
k12.as.us
k12.az.us
k12.ca.us
k12.co.us
k12.ct.us
k12.dc.us
k12.de.us
k12.fl.us
k12.ga.us
k12.gu.us
// k12.hi.us  Bug 614565 - Hawaii has a state-wide DOE login
k12.ia.us
k12.id.us
k12.il.us
k12.in.us
k12.ks.us
k12.ky.us
k12.la.us
k12.ma.us
k12.md.us
k12.me.us
k12.mi.us
k12.mn.us
k12.mo.us
k12.ms.us
k12.mt.us
k12.nc.us
// k12.nd.us  Bug 1028347 - Removed at request of Travis Rosso <trossow@nd.gov>
k12.ne.us
k12.nh.us
k12.nj.us
k12.nm.us
k12.nv.us
k12.ny.us
k12.oh.us
k12.ok.us
k12.or.us
k12.pa.us
k12.pr.us
// k12.ri.us  Removed at request of Kim Cournoyer <netsupport@staff.ri.net>
k12.sc.us
// k12.sd.us  Bug 934131 - Removed at request of James Booze <James.Booze@k12.sd.us>
k12.tn.us
k12.tx.us
k12.ut.us
k12.vi.us
k12.vt.us
k12.va.us
k12.wa.us
k12.wi.us
// k12.wv.us  Bug 947705 - Removed at request of Verne Britton <verne@wvnet.edu>
k12.wy.us
cc.ak.us
cc.al.us
cc.ar.us
cc.as.us
cc.az.us
cc.ca.us
cc.co.us
cc.ct.us
cc.dc.us
cc.de.us
cc.fl.us
cc.ga.us
cc.gu.us
cc.hi.us
cc.ia.us
cc.id.us
cc.il.us
cc.in.us
cc.ks.us
cc.ky.us
cc.la.us
cc.ma.us
cc.md.us
cc.me.us
cc.mi.us
cc.mn.us
cc.mo.us
cc.ms.us
cc.mt.us
cc.nc.us
cc.nd.us
cc.ne.us
cc.nh.us
cc.nj.us
cc.nm.us
cc.nv.us
cc.ny.us
cc.oh.us
cc.ok.us
cc.or.us
cc.pa.us
cc.pr.us
cc.ri.us
cc.sc.us
cc.sd.us
cc.tn.us
cc.tx.us
cc.ut.us
cc.vi.us
cc.vt.us
cc.va.us
cc.wa.us
cc.wi.us
cc.wv.us
cc.wy.us
lib.ak.us
lib.al.us
lib.ar.us
lib.as.us
lib.az.us
lib.ca.us
lib.co.us
lib.ct.us
lib.dc.us
// lib.de.us  Issue #243 - Moved to Private section at request of Ed Moore <Ed.Moore@lib.de.us>
lib.fl.us
lib.ga.us
lib.gu.us
lib.hi.us
lib.ia.us
lib.id.us
lib.il.us
lib.in.us
lib.ks.us
lib.ky.us
lib.la.us
lib.ma.us
lib.md.us
lib.me.us
lib.mi.us
lib.mn.us
lib.mo.us
lib.ms.us
lib.mt.us
lib.nc.us
lib.nd.us
lib.ne.us
lib.nh.us
lib.nj.us
lib.nm.us
lib.nv.us
lib.ny.us
lib.oh.us
lib.ok.us
lib.or.us
lib.pa.us
lib.pr.us
lib.ri.us
lib.sc.us
lib.sd.us
lib.tn.us
lib.tx.us
lib.ut.us
lib.vi.us
lib.vt.us
lib.va.us
lib.wa.us
lib.wi.us
// lib.wv.us  Bug 941670 - Removed at request of Larry W Arnold <arnold@wvlc.lib.wv.us>
lib.wy.us
// k12.ma.us contains school districts in Massachusetts. The 4LDs are
//  managed independently except for private (PVT), charter (CHTR) and
//  parochial (PAROCH) schools.  Those are delegated directly to the
//  5LD operators.   <k12-ma-hostmaster _ at _ rsuc.gweep.net>
pvt.k12.ma.us
chtr.k12.ma.us
paroch.k12.ma.us
// Merit Network, Inc. maintains the registry for =~ /(k12|cc|lib).mi.us/ and the following
//    see also: http://domreg.merit.edu
//    see also: whois -h whois.domreg.merit.edu help
ann-arbor.mi.us
cog.mi.us
dst.mi.us
eaton.mi.us
gen.mi.us
mus.mi.us
tec.mi.us
washtenaw.mi.us

// uy : http://www.nic.org.uy/
uy
com.uy
edu.uy
gub.uy
mil.uy
net.uy
org.uy

// uz : http://www.reg.uz/
uz
co.uz
com.uz
net.uz
org.uz

// va : https://en.wikipedia.org/wiki/.va
va

// vc : https://en.wikipedia.org/wiki/.vc
// Submitted by registry <kshah@ca.afilias.info>
vc
com.vc
net.vc
org.vc
gov.vc
mil.vc
edu.vc

// ve : https://registro.nic.ve/
// Submitted by registry
ve
arts.ve
co.ve
com.ve
e12.ve
edu.ve
firm.ve
gob.ve
gov.ve
info.ve
int.ve
mil.ve
net.ve
org.ve
rec.ve
store.ve
tec.ve
web.ve

// vg : https://en.wikipedia.org/wiki/.vg
vg

// vi : http://www.nic.vi/newdomainform.htm
// http://www.nic.vi/Domain_Rules/body_domain_rules.html indicates some other
// TLDs are "reserved", such as edu.vi and gov.vi, but doesn't actually say they
// are available for registration (which they do not seem to be).
vi
co.vi
com.vi
k12.vi
net.vi
org.vi

// vn : https://www.dot.vn/vnnic/vnnic/domainregistration.jsp
vn
com.vn
net.vn
org.vn
edu.vn
gov.vn
int.vn
ac.vn
biz.vn
info.vn
name.vn
pro.vn
health.vn

// vu : https://en.wikipedia.org/wiki/.vu
// http://www.vunic.vu/
vu
com.vu
edu.vu
net.vu
org.vu

// wf : http://www.afnic.fr/medias/documents/AFNIC-naming-policy2012.pdf
wf

// ws : https://en.wikipedia.org/wiki/.ws
// http://samoanic.ws/index.dhtml
ws
com.ws
net.ws
org.ws
gov.ws
edu.ws

// yt : http://www.afnic.fr/medias/documents/AFNIC-naming-policy2012.pdf
yt

// IDN ccTLDs
// When submitting patches, please maintain a sort by ISO 3166 ccTLD, then
// U-label, and follow this format:
// // A-Label ("<Latin renderings>", <language name>[, variant info]) : <ISO 3166 ccTLD>
// // [sponsoring org]
// U-Label

// xn--mgbaam7a8h ("Emerat", Arabic) : AE
// http://nic.ae/english/arabicdomain/rules.jsp
xn--mgbaam7a8h

// xn--y9a3aq ("hye", Armenian) : AM
// ISOC AM (operated by .am Registry)
xn--y9a3aq

// xn--54b7fta0cc ("Bangla", Bangla) : BD
xn--54b7fta0cc

// xn--90ae ("bg", Bulgarian) : BG
xn--90ae

// xn--mgbcpq6gpa1a ("albahrain", Arabic) : BH
xn--mgbcpq6gpa1a

// xn--90ais ("bel", Belarusian/Russian Cyrillic) : BY
// Operated by .by registry
xn--90ais

// xn--fiqs8s ("Zhongguo/China", Chinese, Simplified) : CN
// CNNIC
// http://cnnic.cn/html/Dir/2005/10/11/3218.htm
xn--fiqs8s

// xn--fiqz9s ("Zhongguo/China", Chinese, Traditional) : CN
// CNNIC
// http://cnnic.cn/html/Dir/2005/10/11/3218.htm
xn--fiqz9s

// xn--lgbbat1ad8j ("Algeria/Al Jazair", Arabic) : DZ
xn--lgbbat1ad8j

// xn--wgbh1c ("Egypt/Masr", Arabic) : EG
// http://www.dotmasr.eg/
xn--wgbh1c

// xn--e1a4c ("eu", Cyrillic) : EU
// https://eurid.eu
xn--e1a4c

// xn--qxa6a ("eu", Greek) : EU
// https://eurid.eu
xn--qxa6a

// xn--mgbah1a3hjkrd ("Mauritania", Arabic) : MR
xn--mgbah1a3hjkrd

// xn--node ("ge", Georgian Mkhedruli) : GE
xn--node

// xn--qxam ("el", Greek) : GR
// Hellenic Ministry of Infrastructure, Transport, and Networks
xn--qxam

// xn--j6w193g ("Hong Kong", Chinese) : HK
// https://www.hkirc.hk
// Submitted by registry <hk.tech@hkirc.hk>
// https://www.hkirc.hk/content.jsp?id=30#!/34
xn--j6w193g
xn--55qx5d.xn--j6w193g
xn--wcvs22d.xn--j6w193g
xn--mxtq1m.xn--j6w193g
xn--gmqw5a.xn--j6w193g
xn--od0alg.xn--j6w193g
xn--uc0atv.xn--j6w193g

// xn--2scrj9c ("Bharat", Kannada) : IN
// India
xn--2scrj9c

// xn--3hcrj9c ("Bharat", Oriya) : IN
// India
xn--3hcrj9c

// xn--45br5cyl ("Bharatam", Assamese) : IN
// India
xn--45br5cyl

// xn--h2breg3eve ("Bharatam", Sanskrit) : IN
// India
xn--h2breg3eve

// xn--h2brj9c8c ("Bharot", Santali) : IN
// India
xn--h2brj9c8c

// xn--mgbgu82a ("Bharat", Sindhi) : IN
// India
xn--mgbgu82a

// xn--rvc1e0am3e ("Bharatam", Malayalam) : IN
// India
xn--rvc1e0am3e

// xn--h2brj9c ("Bharat", Devanagari) : IN
// India
xn--h2brj9c

// xn--mgbbh1a ("Bharat", Kashmiri) : IN
// India
xn--mgbbh1a

// xn--mgbbh1a71e ("Bharat", Arabic) : IN
// India
xn--mgbbh1a71e

// xn--fpcrj9c3d ("Bharat", Telugu) : IN
// India
xn--fpcrj9c3d

// xn--gecrj9c ("Bharat", Gujarati) : IN
// India
xn--gecrj9c

// xn--s9brj9c ("Bharat", Gurmukhi) : IN
// India
xn--s9brj9c

// xn--45brj9c ("Bharat", Bengali) : IN
// India
xn--45brj9c

// xn--xkc2dl3a5ee0h ("India", Tamil) : IN
// India
xn--xkc2dl3a5ee0h

// xn--mgba3a4f16a ("Iran", Persian) : IR
xn--mgba3a4f16a

// xn--mgba3a4fra ("Iran", Arabic) : IR
xn--mgba3a4fra

// xn--mgbtx2b ("Iraq", Arabic) : IQ
// Communications and Media Commission
xn--mgbtx2b

// xn--mgbayh7gpa ("al-Ordon", Arabic) : JO
// National Information Technology Center (NITC)
// Royal Scientific Society, Al-Jubeiha
xn--mgbayh7gpa

// xn--3e0b707e ("Republic of Korea", Hangul) : KR
xn--3e0b707e

// xn--80ao21a ("Kaz", Kazakh) : KZ
xn--80ao21a

// xn--q7ce6a ("Lao", Lao) : LA
xn--q7ce6a

// xn--fzc2c9e2c ("Lanka", Sinhalese-Sinhala) : LK
// https://nic.lk
xn--fzc2c9e2c

// xn--xkc2al3hye2a ("Ilangai", Tamil) : LK
// https://nic.lk
xn--xkc2al3hye2a

// xn--mgbc0a9azcg ("Morocco/al-Maghrib", Arabic) : MA
xn--mgbc0a9azcg

// xn--d1alf ("mkd", Macedonian) : MK
// MARnet
xn--d1alf

// xn--l1acc ("mon", Mongolian) : MN
xn--l1acc

// xn--mix891f ("Macao", Chinese, Traditional) : MO
// MONIC / HNET Asia (Registry Operator for .mo)
xn--mix891f

// xn--mix082f ("Macao", Chinese, Simplified) : MO
xn--mix082f

// xn--mgbx4cd0ab ("Malaysia", Malay) : MY
xn--mgbx4cd0ab

// xn--mgb9awbf ("Oman", Arabic) : OM
xn--mgb9awbf

// xn--mgbai9azgqp6j ("Pakistan", Urdu/Arabic) : PK
xn--mgbai9azgqp6j

// xn--mgbai9a5eva00b ("Pakistan", Urdu/Arabic, variant) : PK
xn--mgbai9a5eva00b

// xn--ygbi2ammx ("Falasteen", Arabic) : PS
// The Palestinian National Internet Naming Authority (PNINA)
// http://www.pnina.ps
xn--ygbi2ammx

// xn--90a3ac ("srb", Cyrillic) : RS
// https://www.rnids.rs/en/domains/national-domains
xn--90a3ac
xn--o1ac.xn--90a3ac
xn--c1avg.xn--90a3ac
xn--90azh.xn--90a3ac
xn--d1at.xn--90a3ac
xn--o1ach.xn--90a3ac
xn--80au.xn--90a3ac

// xn--p1ai ("rf", Russian-Cyrillic) : RU
// https://cctld.ru/files/pdf/docs/en/rules_ru-rf.pdf
// Submitted by George Georgievsky <gug@cctld.ru>
xn--p1ai

// xn--wgbl6a ("Qatar", Arabic) : QA
// http://www.ict.gov.qa/
xn--wgbl6a

// xn--mgberp4a5d4ar ("AlSaudiah", Arabic) : SA
// http://www.nic.net.sa/
xn--mgberp4a5d4ar

// xn--mgberp4a5d4a87g ("AlSaudiah", Arabic, variant)  : SA
xn--mgberp4a5d4a87g

// xn--mgbqly7c0a67fbc ("AlSaudiah", Arabic, variant) : SA
xn--mgbqly7c0a67fbc

// xn--mgbqly7cvafr ("AlSaudiah", Arabic, variant) : SA
xn--mgbqly7cvafr

// xn--mgbpl2fh ("sudan", Arabic) : SD
// Operated by .sd registry
xn--mgbpl2fh

// xn--yfro4i67o Singapore ("Singapore", Chinese) : SG
xn--yfro4i67o

// xn--clchc0ea0b2g2a9gcd ("Singapore", Tamil) : SG
xn--clchc0ea0b2g2a9gcd

// xn--ogbpf8fl ("Syria", Arabic) : SY
xn--ogbpf8fl

// xn--mgbtf8fl ("Syria", Arabic, variant) : SY
xn--mgbtf8fl

// xn--o3cw4h ("Thai", Thai) : TH
// http://www.thnic.co.th
xn--o3cw4h
xn--12c1fe0br.xn--o3cw4h
xn--12co0c3b4eva.xn--o3cw4h
xn--h3cuzk1di.xn--o3cw4h
xn--o3cyx2a.xn--o3cw4h
xn--m3ch0j3a.xn--o3cw4h
xn--12cfi8ixb8l.xn--o3cw4h

// xn--pgbs0dh ("Tunisia", Arabic) : TN
// http://nic.tn
xn--pgbs0dh

// xn--kpry57d ("Taiwan", Chinese, Traditional) : TW
// http://www.twnic.net/english/dn/dn_07a.htm
xn--kpry57d

// xn--kprw13d ("Taiwan", Chinese, Simplified) : TW
// http://www.twnic.net/english/dn/dn_07a.htm
xn--kprw13d

// xn--nnx388a ("Taiwan", Chinese, variant) : TW
xn--nnx388a

// xn--j1amh ("ukr", Cyrillic) : UA
xn--j1amh

// xn--mgb2ddes ("AlYemen", Arabic) : YE
xn--mgb2ddes

// xxx : http://icmregistry.com
xxx

// ye : http://www.y.net.ye/services/domain_name.htm
ye
com.ye
edu.ye
gov.ye
net.ye
mil.ye
org.ye

// za : https://www.zadna.org.za/content/page/domain-information/
ac.za
agric.za
alt.za
co.za
edu.za
gov.za
grondar.za
law.za
mil.za
net.za
ngo.za
nic.za
nis.za
nom.za
org.za
school.za
tm.za
web.za

// zm : https://zicta.zm/
// Submitted by registry <info@zicta.zm>
zm
ac.zm
biz.zm
co.zm
com.zm
edu.zm
gov.zm
info.zm
mil.zm
net.zm
org.zm
sch.zm

// zw : https://www.potraz.gov.zw/
// Confirmed by registry <bmtengwa@potraz.gov.zw> 2017-01-25
zw
ac.zw
co.zw
gov.zw
mil.zw
org.zw


// newGTLDs

// List of new gTLDs imported from https://www.icann.org/resources/registries/gtlds/v2/gtlds.json on 2021-08-05T15:14:20Z
// This list is auto-generated, don't edit it manually.
// aaa : 2015-02-26 American Automobile Association, Inc.
aaa

// aarp : 2015-05-21 AARP
aarp

// abarth : 2015-07-30 Fiat Chrysler Automobiles N.V.
abarth

// abb : 2014-10-24 ABB Ltd
abb

// abbott : 2014-07-24 Abbott Laboratories, Inc.
abbott

// abbvie : 2015-07-30 AbbVie Inc.
abbvie

// abc : 2015-07-30 Disney Enterprises, Inc.
abc

// able : 2015-06-25 Able Inc.
able

// abogado : 2014-04-24 Registry Services, LLC
abogado

// abudhabi : 2015-07-30 Abu Dhabi Systems and Information Centre
abudhabi

// academy : 2013-11-07 Binky Moon, LLC
academy

// accenture : 2014-08-15 Accenture plc
accenture

// accountant : 2014-11-20 dot Accountant Limited
accountant

// accountants : 2014-03-20 Binky Moon, LLC
accountants

// aco : 2015-01-08 ACO Severin Ahlmann GmbH & Co. KG
aco

// actor : 2013-12-12 Dog Beach, LLC
actor

// adac : 2015-07-16 Allgemeiner Deutscher Automobil-Club e.V. (ADAC)
adac

// ads : 2014-12-04 Charleston Road Registry Inc.
ads

// adult : 2014-10-16 ICM Registry AD LLC
adult

// aeg : 2015-03-19 Aktiebolaget Electrolux
aeg

// aetna : 2015-05-21 Aetna Life Insurance Company
aetna

// afamilycompany : 2015-07-23 Johnson Shareholdings, Inc.
afamilycompany

// afl : 2014-10-02 Australian Football League
afl

// africa : 2014-03-24 ZA Central Registry NPC trading as Registry.Africa
africa

// agakhan : 2015-04-23 Fondation Aga Khan (Aga Khan Foundation)
agakhan

// agency : 2013-11-14 Binky Moon, LLC
agency

// aig : 2014-12-18 American International Group, Inc.
aig

// airbus : 2015-07-30 Airbus S.A.S.
airbus

// airforce : 2014-03-06 Dog Beach, LLC
airforce

// airtel : 2014-10-24 Bharti Airtel Limited
airtel

// akdn : 2015-04-23 Fondation Aga Khan (Aga Khan Foundation)
akdn

// alfaromeo : 2015-07-31 Fiat Chrysler Automobiles N.V.
alfaromeo

// alibaba : 2015-01-15 Alibaba Group Holding Limited
alibaba

// alipay : 2015-01-15 Alibaba Group Holding Limited
alipay

// allfinanz : 2014-07-03 Allfinanz Deutsche Vermögensberatung Aktiengesellschaft
allfinanz

// allstate : 2015-07-31 Allstate Fire and Casualty Insurance Company
allstate

// ally : 2015-06-18 Ally Financial Inc.
ally

// alsace : 2014-07-02 Region Grand Est
alsace

// alstom : 2015-07-30 ALSTOM
alstom

// amazon : 2019-12-19 Amazon Registry Services, Inc.
amazon

// americanexpress : 2015-07-31 American Express Travel Related Services Company, Inc.
americanexpress

// americanfamily : 2015-07-23 AmFam, Inc.
americanfamily

// amex : 2015-07-31 American Express Travel Related Services Company, Inc.
amex

// amfam : 2015-07-23 AmFam, Inc.
amfam

// amica : 2015-05-28 Amica Mutual Insurance Company
amica

// amsterdam : 2014-07-24 Gemeente Amsterdam
amsterdam

// analytics : 2014-12-18 Campus IP LLC
analytics

// android : 2014-08-07 Charleston Road Registry Inc.
android

// anquan : 2015-01-08 Beijing Qihu Keji Co., Ltd.
anquan

// anz : 2015-07-31 Australia and New Zealand Banking Group Limited
anz

// aol : 2015-09-17 Oath Inc.
aol

// apartments : 2014-12-11 Binky Moon, LLC
apartments

// app : 2015-05-14 Charleston Road Registry Inc.
app

// apple : 2015-05-14 Apple Inc.
apple

// aquarelle : 2014-07-24 Aquarelle.com
aquarelle

// arab : 2015-11-12 League of Arab States
arab

// aramco : 2014-11-20 Aramco Services Company
aramco

// archi : 2014-02-06 Afilias Limited
archi

// army : 2014-03-06 Dog Beach, LLC
army

// art : 2016-03-24 UK Creative Ideas Limited
art

// arte : 2014-12-11 Association Relative à la Télévision Européenne G.E.I.E.
arte

// asda : 2015-07-31 Wal-Mart Stores, Inc.
asda

// associates : 2014-03-06 Binky Moon, LLC
associates

// athleta : 2015-07-30 The Gap, Inc.
athleta

// attorney : 2014-03-20 Dog Beach, LLC
attorney

// auction : 2014-03-20 Dog Beach, LLC
auction

// audi : 2015-05-21 AUDI Aktiengesellschaft
audi

// audible : 2015-06-25 Amazon Registry Services, Inc.
audible

// audio : 2014-03-20 UNR Corp.
audio

// auspost : 2015-08-13 Australian Postal Corporation
auspost

// author : 2014-12-18 Amazon Registry Services, Inc.
author

// auto : 2014-11-13 XYZ.COM LLC
auto

// autos : 2014-01-09 XYZ.COM LLC
autos

// avianca : 2015-01-08 Avianca Holdings S.A.
avianca

// aws : 2015-06-25 AWS Registry LLC
aws

// axa : 2013-12-19 AXA Group Operations SAS
axa

// azure : 2014-12-18 Microsoft Corporation
azure

// baby : 2015-04-09 XYZ.COM LLC
baby

// baidu : 2015-01-08 Baidu, Inc.
baidu

// banamex : 2015-07-30 Citigroup Inc.
banamex

// bananarepublic : 2015-07-31 The Gap, Inc.
bananarepublic

// band : 2014-06-12 Dog Beach, LLC
band

// bank : 2014-09-25 fTLD Registry Services LLC
bank

// bar : 2013-12-12 Punto 2012 Sociedad Anonima Promotora de Inversion de Capital Variable
bar

// barcelona : 2014-07-24 Municipi de Barcelona
barcelona

// barclaycard : 2014-11-20 Barclays Bank PLC
barclaycard

// barclays : 2014-11-20 Barclays Bank PLC
barclays

// barefoot : 2015-06-11 Gallo Vineyards, Inc.
barefoot

// bargains : 2013-11-14 Binky Moon, LLC
bargains

// baseball : 2015-10-29 MLB Advanced Media DH, LLC
baseball

// basketball : 2015-08-20 Fédération Internationale de Basketball (FIBA)
basketball

// bauhaus : 2014-04-17 Werkhaus GmbH
bauhaus

// bayern : 2014-01-23 Bayern Connect GmbH
bayern

// bbc : 2014-12-18 British Broadcasting Corporation
bbc

// bbt : 2015-07-23 BB&T Corporation
bbt

// bbva : 2014-10-02 BANCO BILBAO VIZCAYA ARGENTARIA, S.A.
bbva

// bcg : 2015-04-02 The Boston Consulting Group, Inc.
bcg

// bcn : 2014-07-24 Municipi de Barcelona
bcn

// beats : 2015-05-14 Beats Electronics, LLC
beats

// beauty : 2015-12-03 XYZ.COM LLC
beauty

// beer : 2014-01-09 Registry Services, LLC
beer

// bentley : 2014-12-18 Bentley Motors Limited
bentley

// berlin : 2013-10-31 dotBERLIN GmbH & Co. KG
berlin

// best : 2013-12-19 BestTLD Pty Ltd
best

// bestbuy : 2015-07-31 BBY Solutions, Inc.
bestbuy

// bet : 2015-05-07 Afilias Limited
bet

// bharti : 2014-01-09 Bharti Enterprises (Holding) Private Limited
bharti

// bible : 2014-06-19 American Bible Society
bible

// bid : 2013-12-19 dot Bid Limited
bid

// bike : 2013-08-27 Binky Moon, LLC
bike

// bing : 2014-12-18 Microsoft Corporation
bing

// bingo : 2014-12-04 Binky Moon, LLC
bingo

// bio : 2014-03-06 Afilias Limited
bio

// black : 2014-01-16 Afilias Limited
black

// blackfriday : 2014-01-16 UNR Corp.
blackfriday

// blockbuster : 2015-07-30 Dish DBS Corporation
blockbuster

// blog : 2015-05-14 Knock Knock WHOIS There, LLC
blog

// bloomberg : 2014-07-17 Bloomberg IP Holdings LLC
bloomberg

// blue : 2013-11-07 Afilias Limited
blue

// bms : 2014-10-30 Bristol-Myers Squibb Company
bms

// bmw : 2014-01-09 Bayerische Motoren Werke Aktiengesellschaft
bmw

// bnpparibas : 2014-05-29 BNP Paribas
bnpparibas

// boats : 2014-12-04 XYZ.COM LLC
boats

// boehringer : 2015-07-09 Boehringer Ingelheim International GmbH
boehringer

// bofa : 2015-07-31 Bank of America Corporation
bofa

// bom : 2014-10-16 Núcleo de Informação e Coordenação do Ponto BR - NIC.br
bom

// bond : 2014-06-05 ShortDot SA
bond

// boo : 2014-01-30 Charleston Road Registry Inc.
boo

// book : 2015-08-27 Amazon Registry Services, Inc.
book

// booking : 2015-07-16 Booking.com B.V.
booking

// bosch : 2015-06-18 Robert Bosch GMBH
bosch

// bostik : 2015-05-28 Bostik SA
bostik

// boston : 2015-12-10 Boston TLD Management, LLC
boston

// bot : 2014-12-18 Amazon Registry Services, Inc.
bot

// boutique : 2013-11-14 Binky Moon, LLC
boutique

// box : 2015-11-12 Intercap Registry Inc.
box

// bradesco : 2014-12-18 Banco Bradesco S.A.
bradesco

// bridgestone : 2014-12-18 Bridgestone Corporation
bridgestone

// broadway : 2014-12-22 Celebrate Broadway, Inc.
broadway

// broker : 2014-12-11 Dog Beach, LLC
broker

// brother : 2015-01-29 Brother Industries, Ltd.
brother

// brussels : 2014-02-06 DNS.be vzw
brussels

// budapest : 2013-11-21 Minds + Machines Group Limited
budapest

// bugatti : 2015-07-23 Bugatti International SA
bugatti

// build : 2013-11-07 Plan Bee LLC
build

// builders : 2013-11-07 Binky Moon, LLC
builders

// business : 2013-11-07 Binky Moon, LLC
business

// buy : 2014-12-18 Amazon Registry Services, Inc.
buy

// buzz : 2013-10-02 DOTSTRATEGY CO.
buzz

// bzh : 2014-02-27 Association www.bzh
bzh

// cab : 2013-10-24 Binky Moon, LLC
cab

// cafe : 2015-02-11 Binky Moon, LLC
cafe

// cal : 2014-07-24 Charleston Road Registry Inc.
cal

// call : 2014-12-18 Amazon Registry Services, Inc.
call

// calvinklein : 2015-07-30 PVH gTLD Holdings LLC
calvinklein

// cam : 2016-04-21 AC Webconnecting Holding B.V.
cam

// camera : 2013-08-27 Binky Moon, LLC
camera

// camp : 2013-11-07 Binky Moon, LLC
camp

// cancerresearch : 2014-05-15 Australian Cancer Research Foundation
cancerresearch

// canon : 2014-09-12 Canon Inc.
canon

// capetown : 2014-03-24 ZA Central Registry NPC trading as ZA Central Registry
capetown

// capital : 2014-03-06 Binky Moon, LLC
capital

// capitalone : 2015-08-06 Capital One Financial Corporation
capitalone

// car : 2015-01-22 XYZ.COM LLC
car

// caravan : 2013-12-12 Caravan International, Inc.
caravan

// cards : 2013-12-05 Binky Moon, LLC
cards

// care : 2014-03-06 Binky Moon, LLC
care

// career : 2013-10-09 dotCareer LLC
career

// careers : 2013-10-02 Binky Moon, LLC
careers

// cars : 2014-11-13 XYZ.COM LLC
cars

// casa : 2013-11-21 Registry Services, LLC
casa

// case : 2015-09-03 CNH Industrial N.V.
case

// cash : 2014-03-06 Binky Moon, LLC
cash

// casino : 2014-12-18 Binky Moon, LLC
casino

// catering : 2013-12-05 Binky Moon, LLC
catering

// catholic : 2015-10-21 Pontificium Consilium de Comunicationibus Socialibus (PCCS) (Pontifical Council for Social Communication)
catholic

// cba : 2014-06-26 COMMONWEALTH BANK OF AUSTRALIA
cba

// cbn : 2014-08-22 The Christian Broadcasting Network, Inc.
cbn

// cbre : 2015-07-02 CBRE, Inc.
cbre

// cbs : 2015-08-06 CBS Domains Inc.
cbs

// center : 2013-11-07 Binky Moon, LLC
center

// ceo : 2013-11-07 CEOTLD Pty Ltd
ceo

// cern : 2014-06-05 European Organization for Nuclear Research ("CERN")
cern

// cfa : 2014-08-28 CFA Institute
cfa

// cfd : 2014-12-11 ShortDot SA
cfd

// chanel : 2015-04-09 Chanel International B.V.
chanel

// channel : 2014-05-08 Charleston Road Registry Inc.
channel

// charity : 2018-04-11 Binky Moon, LLC
charity

// chase : 2015-04-30 JPMorgan Chase Bank, National Association
chase

// chat : 2014-12-04 Binky Moon, LLC
chat

// cheap : 2013-11-14 Binky Moon, LLC
cheap

// chintai : 2015-06-11 CHINTAI Corporation
chintai

// christmas : 2013-11-21 UNR Corp.
christmas

// chrome : 2014-07-24 Charleston Road Registry Inc.
chrome

// church : 2014-02-06 Binky Moon, LLC
church

// cipriani : 2015-02-19 Hotel Cipriani Srl
cipriani

// circle : 2014-12-18 Amazon Registry Services, Inc.
circle

// cisco : 2014-12-22 Cisco Technology, Inc.
cisco

// citadel : 2015-07-23 Citadel Domain LLC
citadel

// citi : 2015-07-30 Citigroup Inc.
citi

// citic : 2014-01-09 CITIC Group Corporation
citic

// city : 2014-05-29 Binky Moon, LLC
city

// cityeats : 2014-12-11 Lifestyle Domain Holdings, Inc.
cityeats

// claims : 2014-03-20 Binky Moon, LLC
claims

// cleaning : 2013-12-05 Binky Moon, LLC
cleaning

// click : 2014-06-05 UNR Corp.
click

// clinic : 2014-03-20 Binky Moon, LLC
clinic

// clinique : 2015-10-01 The Estée Lauder Companies Inc.
clinique

// clothing : 2013-08-27 Binky Moon, LLC
clothing

// cloud : 2015-04-16 Aruba PEC S.p.A.
cloud

// club : 2013-11-08 Registry Services, LLC
club

// clubmed : 2015-06-25 Club Méditerranée S.A.
clubmed

// coach : 2014-10-09 Binky Moon, LLC
coach

// codes : 2013-10-31 Binky Moon, LLC
codes

// coffee : 2013-10-17 Binky Moon, LLC
coffee

// college : 2014-01-16 XYZ.COM LLC
college

// cologne : 2014-02-05 dotKoeln GmbH
cologne

// comcast : 2015-07-23 Comcast IP Holdings I, LLC
comcast

// commbank : 2014-06-26 COMMONWEALTH BANK OF AUSTRALIA
commbank

// community : 2013-12-05 Binky Moon, LLC
community

// company : 2013-11-07 Binky Moon, LLC
company

// compare : 2015-10-08 Registry Services, LLC
compare

// computer : 2013-10-24 Binky Moon, LLC
computer

// comsec : 2015-01-08 VeriSign, Inc.
comsec

// condos : 2013-12-05 Binky Moon, LLC
condos

// construction : 2013-09-16 Binky Moon, LLC
construction

// consulting : 2013-12-05 Dog Beach, LLC
consulting

// contact : 2015-01-08 Dog Beach, LLC
contact

// contractors : 2013-09-10 Binky Moon, LLC
contractors

// cooking : 2013-11-21 Registry Services, LLC
cooking

// cookingchannel : 2015-07-02 Lifestyle Domain Holdings, Inc.
cookingchannel

// cool : 2013-11-14 Binky Moon, LLC
cool

// corsica : 2014-09-25 Collectivité de Corse
corsica

// country : 2013-12-19 DotCountry LLC
country

// coupon : 2015-02-26 Amazon Registry Services, Inc.
coupon

// coupons : 2015-03-26 Binky Moon, LLC
coupons

// courses : 2014-12-04 OPEN UNIVERSITIES AUSTRALIA PTY LTD
courses

// cpa : 2019-06-10 American Institute of Certified Public Accountants
cpa

// credit : 2014-03-20 Binky Moon, LLC
credit

// creditcard : 2014-03-20 Binky Moon, LLC
creditcard

// creditunion : 2015-01-22 DotCooperation LLC
creditunion

// cricket : 2014-10-09 dot Cricket Limited
cricket

// crown : 2014-10-24 Crown Equipment Corporation
crown

// crs : 2014-04-03 Federated Co-operatives Limited
crs

// cruise : 2015-12-10 Viking River Cruises (Bermuda) Ltd.
cruise

// cruises : 2013-12-05 Binky Moon, LLC
cruises

// csc : 2014-09-25 Alliance-One Services, Inc.
csc

// cuisinella : 2014-04-03 SCHMIDT GROUPE S.A.S.
cuisinella

// cymru : 2014-05-08 Nominet UK
cymru

// cyou : 2015-01-22 ShortDot SA
cyou

// dabur : 2014-02-06 Dabur India Limited
dabur

// dad : 2014-01-23 Charleston Road Registry Inc.
dad

// dance : 2013-10-24 Dog Beach, LLC
dance

// data : 2016-06-02 Dish DBS Corporation
data

// date : 2014-11-20 dot Date Limited
date

// dating : 2013-12-05 Binky Moon, LLC
dating

// datsun : 2014-03-27 NISSAN MOTOR CO., LTD.
datsun

// day : 2014-01-30 Charleston Road Registry Inc.
day

// dclk : 2014-11-20 Charleston Road Registry Inc.
dclk

// dds : 2015-05-07 Registry Services, LLC
dds

// deal : 2015-06-25 Amazon Registry Services, Inc.
deal

// dealer : 2014-12-22 Intercap Registry Inc.
dealer

// deals : 2014-05-22 Binky Moon, LLC
deals

// degree : 2014-03-06 Dog Beach, LLC
degree

// delivery : 2014-09-11 Binky Moon, LLC
delivery

// dell : 2014-10-24 Dell Inc.
dell

// deloitte : 2015-07-31 Deloitte Touche Tohmatsu
deloitte

// delta : 2015-02-19 Delta Air Lines, Inc.
delta

// democrat : 2013-10-24 Dog Beach, LLC
democrat

// dental : 2014-03-20 Binky Moon, LLC
dental

// dentist : 2014-03-20 Dog Beach, LLC
dentist

// desi : 2013-11-14 Desi Networks LLC
desi

// design : 2014-11-07 Registry Services, LLC
design

// dev : 2014-10-16 Charleston Road Registry Inc.
dev

// dhl : 2015-07-23 Deutsche Post AG
dhl

// diamonds : 2013-09-22 Binky Moon, LLC
diamonds

// diet : 2014-06-26 UNR Corp.
diet

// digital : 2014-03-06 Binky Moon, LLC
digital

// direct : 2014-04-10 Binky Moon, LLC
direct

// directory : 2013-09-20 Binky Moon, LLC
directory

// discount : 2014-03-06 Binky Moon, LLC
discount

// discover : 2015-07-23 Discover Financial Services
discover

// dish : 2015-07-30 Dish DBS Corporation
dish

// diy : 2015-11-05 Lifestyle Domain Holdings, Inc.
diy

// dnp : 2013-12-13 Dai Nippon Printing Co., Ltd.
dnp

// docs : 2014-10-16 Charleston Road Registry Inc.
docs

// doctor : 2016-06-02 Binky Moon, LLC
doctor

// dog : 2014-12-04 Binky Moon, LLC
dog

// domains : 2013-10-17 Binky Moon, LLC
domains

// dot : 2015-05-21 Dish DBS Corporation
dot

// download : 2014-11-20 dot Support Limited
download

// drive : 2015-03-05 Charleston Road Registry Inc.
drive

// dtv : 2015-06-04 Dish DBS Corporation
dtv

// dubai : 2015-01-01 Dubai Smart Government Department
dubai

// duck : 2015-07-23 Johnson Shareholdings, Inc.
duck

// dunlop : 2015-07-02 The Goodyear Tire & Rubber Company
dunlop

// dupont : 2015-06-25 E. I. du Pont de Nemours and Company
dupont

// durban : 2014-03-24 ZA Central Registry NPC trading as ZA Central Registry
durban

// dvag : 2014-06-23 Deutsche Vermögensberatung Aktiengesellschaft DVAG
dvag

// dvr : 2016-05-26 DISH Technologies L.L.C.
dvr

// earth : 2014-12-04 Interlink Co., Ltd.
earth

// eat : 2014-01-23 Charleston Road Registry Inc.
eat

// eco : 2016-07-08 Big Room Inc.
eco

// edeka : 2014-12-18 EDEKA Verband kaufmännischer Genossenschaften e.V.
edeka

// education : 2013-11-07 Binky Moon, LLC
education

// email : 2013-10-31 Binky Moon, LLC
email

// emerck : 2014-04-03 Merck KGaA
emerck

// energy : 2014-09-11 Binky Moon, LLC
energy

// engineer : 2014-03-06 Dog Beach, LLC
engineer

// engineering : 2014-03-06 Binky Moon, LLC
engineering

// enterprises : 2013-09-20 Binky Moon, LLC
enterprises

// epson : 2014-12-04 Seiko Epson Corporation
epson

// equipment : 2013-08-27 Binky Moon, LLC
equipment

// ericsson : 2015-07-09 Telefonaktiebolaget L M Ericsson
ericsson

// erni : 2014-04-03 ERNI Group Holding AG
erni

// esq : 2014-05-08 Charleston Road Registry Inc.
esq

// estate : 2013-08-27 Binky Moon, LLC
estate

// etisalat : 2015-09-03 Emirates Telecommunications Corporation (trading as Etisalat)
etisalat

// eurovision : 2014-04-24 European Broadcasting Union (EBU)
eurovision

// eus : 2013-12-12 Puntueus Fundazioa
eus

// events : 2013-12-05 Binky Moon, LLC
events

// exchange : 2014-03-06 Binky Moon, LLC
exchange

// expert : 2013-11-21 Binky Moon, LLC
expert

// exposed : 2013-12-05 Binky Moon, LLC
exposed

// express : 2015-02-11 Binky Moon, LLC
express

// extraspace : 2015-05-14 Extra Space Storage LLC
extraspace

// fage : 2014-12-18 Fage International S.A.
fage

// fail : 2014-03-06 Binky Moon, LLC
fail

// fairwinds : 2014-11-13 FairWinds Partners, LLC
fairwinds

// faith : 2014-11-20 dot Faith Limited
faith

// family : 2015-04-02 Dog Beach, LLC
family

// fan : 2014-03-06 Dog Beach, LLC
fan

// fans : 2014-11-07 ZDNS International Limited
fans

// farm : 2013-11-07 Binky Moon, LLC
farm

// farmers : 2015-07-09 Farmers Insurance Exchange
farmers

// fashion : 2014-07-03 Registry Services, LLC
fashion

// fast : 2014-12-18 Amazon Registry Services, Inc.
fast

// fedex : 2015-08-06 Federal Express Corporation
fedex

// feedback : 2013-12-19 Top Level Spectrum, Inc.
feedback

// ferrari : 2015-07-31 Fiat Chrysler Automobiles N.V.
ferrari

// ferrero : 2014-12-18 Ferrero Trading Lux S.A.
ferrero

// fiat : 2015-07-31 Fiat Chrysler Automobiles N.V.
fiat

// fidelity : 2015-07-30 Fidelity Brokerage Services LLC
fidelity

// fido : 2015-08-06 Rogers Communications Canada Inc.
fido

// film : 2015-01-08 Motion Picture Domain Registry Pty Ltd
film

// final : 2014-10-16 Núcleo de Informação e Coordenação do Ponto BR - NIC.br
final

// finance : 2014-03-20 Binky Moon, LLC
finance

// financial : 2014-03-06 Binky Moon, LLC
financial

// fire : 2015-06-25 Amazon Registry Services, Inc.
fire

// firestone : 2014-12-18 Bridgestone Licensing Services, Inc
firestone

// firmdale : 2014-03-27 Firmdale Holdings Limited
firmdale

// fish : 2013-12-12 Binky Moon, LLC
fish

// fishing : 2013-11-21 Registry Services, LLC
fishing

// fit : 2014-11-07 Registry Services, LLC
fit

// fitness : 2014-03-06 Binky Moon, LLC
fitness

// flickr : 2015-04-02 Flickr, Inc.
flickr

// flights : 2013-12-05 Binky Moon, LLC
flights

// flir : 2015-07-23 FLIR Systems, Inc.
flir

// florist : 2013-11-07 Binky Moon, LLC
florist

// flowers : 2014-10-09 UNR Corp.
flowers

// fly : 2014-05-08 Charleston Road Registry Inc.
fly

// foo : 2014-01-23 Charleston Road Registry Inc.
foo

// food : 2016-04-21 Lifestyle Domain Holdings, Inc.
food

// foodnetwork : 2015-07-02 Lifestyle Domain Holdings, Inc.
foodnetwork

// football : 2014-12-18 Binky Moon, LLC
football

// ford : 2014-11-13 Ford Motor Company
ford

// forex : 2014-12-11 Dog Beach, LLC
forex

// forsale : 2014-05-22 Dog Beach, LLC
forsale

// forum : 2015-04-02 Fegistry, LLC
forum

// foundation : 2013-12-05 Binky Moon, LLC
foundation

// fox : 2015-09-11 FOX Registry, LLC
fox

// free : 2015-12-10 Amazon Registry Services, Inc.
free

// fresenius : 2015-07-30 Fresenius Immobilien-Verwaltungs-GmbH
fresenius

// frl : 2014-05-15 FRLregistry B.V.
frl

// frogans : 2013-12-19 OP3FT
frogans

// frontdoor : 2015-07-02 Lifestyle Domain Holdings, Inc.
frontdoor

// frontier : 2015-02-05 Frontier Communications Corporation
frontier

// ftr : 2015-07-16 Frontier Communications Corporation
ftr

// fujitsu : 2015-07-30 Fujitsu Limited
fujitsu

// fun : 2016-01-14 Radix FZC
fun

// fund : 2014-03-20 Binky Moon, LLC
fund

// furniture : 2014-03-20 Binky Moon, LLC
furniture

// futbol : 2013-09-20 Dog Beach, LLC
futbol

// fyi : 2015-04-02 Binky Moon, LLC
fyi

// gal : 2013-11-07 Asociación puntoGAL
gal

// gallery : 2013-09-13 Binky Moon, LLC
gallery

// gallo : 2015-06-11 Gallo Vineyards, Inc.
gallo

// gallup : 2015-02-19 Gallup, Inc.
gallup

// game : 2015-05-28 UNR Corp.
game

// games : 2015-05-28 Dog Beach, LLC
games

// gap : 2015-07-31 The Gap, Inc.
gap

// garden : 2014-06-26 Registry Services, LLC
garden

// gay : 2019-05-23 Top Level Design, LLC
gay

// gbiz : 2014-07-17 Charleston Road Registry Inc.
gbiz

// gdn : 2014-07-31 Joint Stock Company "Navigation-information systems"
gdn

// gea : 2014-12-04 GEA Group Aktiengesellschaft
gea

// gent : 2014-01-23 COMBELL NV
gent

// genting : 2015-03-12 Resorts World Inc Pte. Ltd.
genting

// george : 2015-07-31 Wal-Mart Stores, Inc.
george

// ggee : 2014-01-09 GMO Internet, Inc.
ggee

// gift : 2013-10-17 DotGift, LLC
gift

// gifts : 2014-07-03 Binky Moon, LLC
gifts

// gives : 2014-03-06 Dog Beach, LLC
gives

// giving : 2014-11-13 Giving Limited
giving

// glade : 2015-07-23 Johnson Shareholdings, Inc.
glade

// glass : 2013-11-07 Binky Moon, LLC
glass

// gle : 2014-07-24 Charleston Road Registry Inc.
gle

// global : 2014-04-17 Dot Global Domain Registry Limited
global

// globo : 2013-12-19 Globo Comunicação e Participações S.A
globo

// gmail : 2014-05-01 Charleston Road Registry Inc.
gmail

// gmbh : 2016-01-29 Binky Moon, LLC
gmbh

// gmo : 2014-01-09 GMO Internet, Inc.
gmo

// gmx : 2014-04-24 1&1 Mail & Media GmbH
gmx

// godaddy : 2015-07-23 Go Daddy East, LLC
godaddy

// gold : 2015-01-22 Binky Moon, LLC
gold

// goldpoint : 2014-11-20 YODOBASHI CAMERA CO.,LTD.
goldpoint

// golf : 2014-12-18 Binky Moon, LLC
golf

// goo : 2014-12-18 NTT Resonant Inc.
goo

// goodyear : 2015-07-02 The Goodyear Tire & Rubber Company
goodyear

// goog : 2014-11-20 Charleston Road Registry Inc.
goog

// google : 2014-07-24 Charleston Road Registry Inc.
google

// gop : 2014-01-16 Republican State Leadership Committee, Inc.
gop

// got : 2014-12-18 Amazon Registry Services, Inc.
got

// grainger : 2015-05-07 Grainger Registry Services, LLC
grainger

// graphics : 2013-09-13 Binky Moon, LLC
graphics

// gratis : 2014-03-20 Binky Moon, LLC
gratis

// green : 2014-05-08 Afilias Limited
green

// gripe : 2014-03-06 Binky Moon, LLC
gripe

// grocery : 2016-06-16 Wal-Mart Stores, Inc.
grocery

// group : 2014-08-15 Binky Moon, LLC
group

// guardian : 2015-07-30 The Guardian Life Insurance Company of America
guardian

// gucci : 2014-11-13 Guccio Gucci S.p.a.
gucci

// guge : 2014-08-28 Charleston Road Registry Inc.
guge

// guide : 2013-09-13 Binky Moon, LLC
guide

// guitars : 2013-11-14 UNR Corp.
guitars

// guru : 2013-08-27 Binky Moon, LLC
guru

// hair : 2015-12-03 XYZ.COM LLC
hair

// hamburg : 2014-02-20 Hamburg Top-Level-Domain GmbH
hamburg

// hangout : 2014-11-13 Charleston Road Registry Inc.
hangout

// haus : 2013-12-05 Dog Beach, LLC
haus

// hbo : 2015-07-30 HBO Registry Services, Inc.
hbo

// hdfc : 2015-07-30 HOUSING DEVELOPMENT FINANCE CORPORATION LIMITED
hdfc

// hdfcbank : 2015-02-12 HDFC Bank Limited
hdfcbank

// health : 2015-02-11 DotHealth, LLC
health

// healthcare : 2014-06-12 Binky Moon, LLC
healthcare

// help : 2014-06-26 UNR Corp.
help

// helsinki : 2015-02-05 City of Helsinki
helsinki

// here : 2014-02-06 Charleston Road Registry Inc.
here

// hermes : 2014-07-10 HERMES INTERNATIONAL
hermes

// hgtv : 2015-07-02 Lifestyle Domain Holdings, Inc.
hgtv

// hiphop : 2014-03-06 UNR Corp.
hiphop

// hisamitsu : 2015-07-16 Hisamitsu Pharmaceutical Co.,Inc.
hisamitsu

// hitachi : 2014-10-31 Hitachi, Ltd.
hitachi

// hiv : 2014-03-13 UNR Corp.
hiv

// hkt : 2015-05-14 PCCW-HKT DataCom Services Limited
hkt

// hockey : 2015-03-19 Binky Moon, LLC
hockey

// holdings : 2013-08-27 Binky Moon, LLC
holdings

// holiday : 2013-11-07 Binky Moon, LLC
holiday

// homedepot : 2015-04-02 Home Depot Product Authority, LLC
homedepot

// homegoods : 2015-07-16 The TJX Companies, Inc.
homegoods

// homes : 2014-01-09 XYZ.COM LLC
homes

// homesense : 2015-07-16 The TJX Companies, Inc.
homesense

// honda : 2014-12-18 Honda Motor Co., Ltd.
honda

// horse : 2013-11-21 Registry Services, LLC
horse

// hospital : 2016-10-20 Binky Moon, LLC
hospital

// host : 2014-04-17 Radix FZC
host

// hosting : 2014-05-29 UNR Corp.
hosting

// hot : 2015-08-27 Amazon Registry Services, Inc.
hot

// hoteles : 2015-03-05 Travel Reservations SRL
hoteles

// hotels : 2016-04-07 Booking.com B.V.
hotels

// hotmail : 2014-12-18 Microsoft Corporation
hotmail

// house : 2013-11-07 Binky Moon, LLC
house

// how : 2014-01-23 Charleston Road Registry Inc.
how

// hsbc : 2014-10-24 HSBC Global Services (UK) Limited
hsbc

// hughes : 2015-07-30 Hughes Satellite Systems Corporation
hughes

// hyatt : 2015-07-30 Hyatt GTLD, L.L.C.
hyatt

// hyundai : 2015-07-09 Hyundai Motor Company
hyundai

// ibm : 2014-07-31 International Business Machines Corporation
ibm

// icbc : 2015-02-19 Industrial and Commercial Bank of China Limited
icbc

// ice : 2014-10-30 IntercontinentalExchange, Inc.
ice

// icu : 2015-01-08 ShortDot SA
icu

// ieee : 2015-07-23 IEEE Global LLC
ieee

// ifm : 2014-01-30 ifm electronic gmbh
ifm

// ikano : 2015-07-09 Ikano S.A.
ikano

// imamat : 2015-08-06 Fondation Aga Khan (Aga Khan Foundation)
imamat

// imdb : 2015-06-25 Amazon Registry Services, Inc.
imdb

// immo : 2014-07-10 Binky Moon, LLC
immo

// immobilien : 2013-11-07 Dog Beach, LLC
immobilien

// inc : 2018-03-10 Intercap Registry Inc.
inc

// industries : 2013-12-05 Binky Moon, LLC
industries

// infiniti : 2014-03-27 NISSAN MOTOR CO., LTD.
infiniti

// ing : 2014-01-23 Charleston Road Registry Inc.
ing

// ink : 2013-12-05 Top Level Design, LLC
ink

// institute : 2013-11-07 Binky Moon, LLC
institute

// insurance : 2015-02-19 fTLD Registry Services LLC
insurance

// insure : 2014-03-20 Binky Moon, LLC
insure

// international : 2013-11-07 Binky Moon, LLC
international

// intuit : 2015-07-30 Intuit Administrative Services, Inc.
intuit

// investments : 2014-03-20 Binky Moon, LLC
investments

// ipiranga : 2014-08-28 Ipiranga Produtos de Petroleo S.A.
ipiranga

// irish : 2014-08-07 Binky Moon, LLC
irish

// ismaili : 2015-08-06 Fondation Aga Khan (Aga Khan Foundation)
ismaili

// ist : 2014-08-28 Istanbul Metropolitan Municipality
ist

// istanbul : 2014-08-28 Istanbul Metropolitan Municipality
istanbul

// itau : 2014-10-02 Itau Unibanco Holding S.A.
itau

// itv : 2015-07-09 ITV Services Limited
itv

// jaguar : 2014-11-13 Jaguar Land Rover Ltd
jaguar

// java : 2014-06-19 Oracle Corporation
java

// jcb : 2014-11-20 JCB Co., Ltd.
jcb

// jeep : 2015-07-30 FCA US LLC.
jeep

// jetzt : 2014-01-09 Binky Moon, LLC
jetzt

// jewelry : 2015-03-05 Binky Moon, LLC
jewelry

// jio : 2015-04-02 Reliance Industries Limited
jio

// jll : 2015-04-02 Jones Lang LaSalle Incorporated
jll

// jmp : 2015-03-26 Matrix IP LLC
jmp

// jnj : 2015-06-18 Johnson & Johnson Services, Inc.
jnj

// joburg : 2014-03-24 ZA Central Registry NPC trading as ZA Central Registry
joburg

// jot : 2014-12-18 Amazon Registry Services, Inc.
jot

// joy : 2014-12-18 Amazon Registry Services, Inc.
joy

// jpmorgan : 2015-04-30 JPMorgan Chase Bank, National Association
jpmorgan

// jprs : 2014-09-18 Japan Registry Services Co., Ltd.
jprs

// juegos : 2014-03-20 UNR Corp.
juegos

// juniper : 2015-07-30 JUNIPER NETWORKS, INC.
juniper

// kaufen : 2013-11-07 Dog Beach, LLC
kaufen

// kddi : 2014-09-12 KDDI CORPORATION
kddi

// kerryhotels : 2015-04-30 Kerry Trading Co. Limited
kerryhotels

// kerrylogistics : 2015-04-09 Kerry Trading Co. Limited
kerrylogistics

// kerryproperties : 2015-04-09 Kerry Trading Co. Limited
kerryproperties

// kfh : 2014-12-04 Kuwait Finance House
kfh

// kia : 2015-07-09 KIA MOTORS CORPORATION
kia

// kim : 2013-09-23 Afilias Limited
kim

// kinder : 2014-11-07 Ferrero Trading Lux S.A.
kinder

// kindle : 2015-06-25 Amazon Registry Services, Inc.
kindle

// kitchen : 2013-09-20 Binky Moon, LLC
kitchen

// kiwi : 2013-09-20 DOT KIWI LIMITED
kiwi

// koeln : 2014-01-09 dotKoeln GmbH
koeln

// komatsu : 2015-01-08 Komatsu Ltd.
komatsu

// kosher : 2015-08-20 Kosher Marketing Assets LLC
kosher

// kpmg : 2015-04-23 KPMG International Cooperative (KPMG International Genossenschaft)
kpmg

// kpn : 2015-01-08 Koninklijke KPN N.V.
kpn

// krd : 2013-12-05 KRG Department of Information Technology
krd

// kred : 2013-12-19 KredTLD Pty Ltd
kred

// kuokgroup : 2015-04-09 Kerry Trading Co. Limited
kuokgroup

// kyoto : 2014-11-07 Academic Institution: Kyoto Jyoho Gakuen
kyoto

// lacaixa : 2014-01-09 Fundación Bancaria Caixa d’Estalvis i Pensions de Barcelona, “la Caixa”
lacaixa

// lamborghini : 2015-06-04 Automobili Lamborghini S.p.A.
lamborghini

// lamer : 2015-10-01 The Estée Lauder Companies Inc.
lamer

// lancaster : 2015-02-12 LANCASTER
lancaster

// lancia : 2015-07-31 Fiat Chrysler Automobiles N.V.
lancia

// land : 2013-09-10 Binky Moon, LLC
land

// landrover : 2014-11-13 Jaguar Land Rover Ltd
landrover

// lanxess : 2015-07-30 LANXESS Corporation
lanxess

// lasalle : 2015-04-02 Jones Lang LaSalle Incorporated
lasalle

// lat : 2014-10-16 ECOM-LAC Federaciòn de Latinoamèrica y el Caribe para Internet y el Comercio Electrònico
lat

// latino : 2015-07-30 Dish DBS Corporation
latino

// latrobe : 2014-06-16 La Trobe University
latrobe

// law : 2015-01-22 Registry Services, LLC
law

// lawyer : 2014-03-20 Dog Beach, LLC
lawyer

// lds : 2014-03-20 IRI Domain Management, LLC
lds

// lease : 2014-03-06 Binky Moon, LLC
lease

// leclerc : 2014-08-07 A.C.D. LEC Association des Centres Distributeurs Edouard Leclerc
leclerc

// lefrak : 2015-07-16 LeFrak Organization, Inc.
lefrak

// legal : 2014-10-16 Binky Moon, LLC
legal

// lego : 2015-07-16 LEGO Juris A/S
lego

// lexus : 2015-04-23 TOYOTA MOTOR CORPORATION
lexus

// lgbt : 2014-05-08 Afilias Limited
lgbt

// lidl : 2014-09-18 Schwarz Domains und Services GmbH & Co. KG
lidl

// life : 2014-02-06 Binky Moon, LLC
life

// lifeinsurance : 2015-01-15 American Council of Life Insurers
lifeinsurance

// lifestyle : 2014-12-11 Lifestyle Domain Holdings, Inc.
lifestyle

// lighting : 2013-08-27 Binky Moon, LLC
lighting

// like : 2014-12-18 Amazon Registry Services, Inc.
like

// lilly : 2015-07-31 Eli Lilly and Company
lilly

// limited : 2014-03-06 Binky Moon, LLC
limited

// limo : 2013-10-17 Binky Moon, LLC
limo

// lincoln : 2014-11-13 Ford Motor Company
lincoln

// linde : 2014-12-04 Linde Aktiengesellschaft
linde

// link : 2013-11-14 UNR Corp.
link

// lipsy : 2015-06-25 Lipsy Ltd
lipsy

// live : 2014-12-04 Dog Beach, LLC
live

// living : 2015-07-30 Lifestyle Domain Holdings, Inc.
living

// lixil : 2015-03-19 LIXIL Group Corporation
lixil

// llc : 2017-12-14 Afilias Limited
llc

// llp : 2019-08-26 UNR Corp.
llp

// loan : 2014-11-20 dot Loan Limited
loan

// loans : 2014-03-20 Binky Moon, LLC
loans

// locker : 2015-06-04 Dish DBS Corporation
locker

// locus : 2015-06-25 Locus Analytics LLC
locus

// loft : 2015-07-30 Annco, Inc.
loft

// lol : 2015-01-30 UNR Corp.
lol

// london : 2013-11-14 Dot London Domains Limited
london

// lotte : 2014-11-07 Lotte Holdings Co., Ltd.
lotte

// lotto : 2014-04-10 Afilias Limited
lotto

// love : 2014-12-22 Merchant Law Group LLP
love

// lpl : 2015-07-30 LPL Holdings, Inc.
lpl

// lplfinancial : 2015-07-30 LPL Holdings, Inc.
lplfinancial

// ltd : 2014-09-25 Binky Moon, LLC
ltd

// ltda : 2014-04-17 InterNetX, Corp
ltda

// lundbeck : 2015-08-06 H. Lundbeck A/S
lundbeck

// luxe : 2014-01-09 Registry Services, LLC
luxe

// luxury : 2013-10-17 Luxury Partners, LLC
luxury

// macys : 2015-07-31 Macys, Inc.
macys

// madrid : 2014-05-01 Comunidad de Madrid
madrid

// maif : 2014-10-02 Mutuelle Assurance Instituteur France (MAIF)
maif

// maison : 2013-12-05 Binky Moon, LLC
maison

// makeup : 2015-01-15 XYZ.COM LLC
makeup

// man : 2014-12-04 MAN SE
man

// management : 2013-11-07 Binky Moon, LLC
management

// mango : 2013-10-24 PUNTO FA S.L.
mango

// map : 2016-06-09 Charleston Road Registry Inc.
map

// market : 2014-03-06 Dog Beach, LLC
market

// marketing : 2013-11-07 Binky Moon, LLC
marketing

// markets : 2014-12-11 Dog Beach, LLC
markets

// marriott : 2014-10-09 Marriott Worldwide Corporation
marriott

// marshalls : 2015-07-16 The TJX Companies, Inc.
marshalls

// maserati : 2015-07-31 Fiat Chrysler Automobiles N.V.
maserati

// mattel : 2015-08-06 Mattel Sites, Inc.
mattel

// mba : 2015-04-02 Binky Moon, LLC
mba

// mckinsey : 2015-07-31 McKinsey Holdings, Inc.
mckinsey

// med : 2015-08-06 Medistry LLC
med

// media : 2014-03-06 Binky Moon, LLC
media

// meet : 2014-01-16 Charleston Road Registry Inc.
meet

// melbourne : 2014-05-29 The Crown in right of the State of Victoria, represented by its Department of State Development, Business and Innovation
melbourne

// meme : 2014-01-30 Charleston Road Registry Inc.
meme

// memorial : 2014-10-16 Dog Beach, LLC
memorial

// men : 2015-02-26 Exclusive Registry Limited
men

// menu : 2013-09-11 Dot Menu Registry, LLC
menu

// merckmsd : 2016-07-14 MSD Registry Holdings, Inc.
merckmsd

// miami : 2013-12-19 Minds + Machines Group Limited
miami

// microsoft : 2014-12-18 Microsoft Corporation
microsoft

// mini : 2014-01-09 Bayerische Motoren Werke Aktiengesellschaft
mini

// mint : 2015-07-30 Intuit Administrative Services, Inc.
mint

// mit : 2015-07-02 Massachusetts Institute of Technology
mit

// mitsubishi : 2015-07-23 Mitsubishi Corporation
mitsubishi

// mlb : 2015-05-21 MLB Advanced Media DH, LLC
mlb

// mls : 2015-04-23 The Canadian Real Estate Association
mls

// mma : 2014-11-07 MMA IARD
mma

// mobile : 2016-06-02 Dish DBS Corporation
mobile

// moda : 2013-11-07 Dog Beach, LLC
moda

// moe : 2013-11-13 Interlink Co., Ltd.
moe

// moi : 2014-12-18 Amazon Registry Services, Inc.
moi

// mom : 2015-04-16 UNR Corp.
mom

// monash : 2013-09-30 Monash University
monash

// money : 2014-10-16 Binky Moon, LLC
money

// monster : 2015-09-11 XYZ.COM LLC
monster

// mormon : 2013-12-05 IRI Domain Management, LLC
mormon

// mortgage : 2014-03-20 Dog Beach, LLC
mortgage

// moscow : 2013-12-19 Foundation for Assistance for Internet Technologies and Infrastructure Development (FAITID)
moscow

// moto : 2015-06-04 Motorola Trademark Holdings, LLC
moto

// motorcycles : 2014-01-09 XYZ.COM LLC
motorcycles

// mov : 2014-01-30 Charleston Road Registry Inc.
mov

// movie : 2015-02-05 Binky Moon, LLC
movie

// msd : 2015-07-23 MSD Registry Holdings, Inc.
msd

// mtn : 2014-12-04 MTN Dubai Limited
mtn

// mtr : 2015-03-12 MTR Corporation Limited
mtr

// music : 2021-05-04 DotMusic Limited
music

// mutual : 2015-04-02 Northwestern Mutual MU TLD Registry, LLC
mutual

// nab : 2015-08-20 National Australia Bank Limited
nab

// nagoya : 2013-10-24 GMO Registry, Inc.
nagoya

// natura : 2015-03-12 NATURA COSMÉTICOS S.A.
natura

// navy : 2014-03-06 Dog Beach, LLC
navy

// nba : 2015-07-31 NBA REGISTRY, LLC
nba

// nec : 2015-01-08 NEC Corporation
nec

// netbank : 2014-06-26 COMMONWEALTH BANK OF AUSTRALIA
netbank

// netflix : 2015-06-18 Netflix, Inc.
netflix

// network : 2013-11-14 Binky Moon, LLC
network

// neustar : 2013-12-05 NeuStar, Inc.
neustar

// new : 2014-01-30 Charleston Road Registry Inc.
new

// news : 2014-12-18 Dog Beach, LLC
news

// next : 2015-06-18 Next plc
next

// nextdirect : 2015-06-18 Next plc
nextdirect

// nexus : 2014-07-24 Charleston Road Registry Inc.
nexus

// nfl : 2015-07-23 NFL Reg Ops LLC
nfl

// ngo : 2014-03-06 Public Interest Registry
ngo

// nhk : 2014-02-13 Japan Broadcasting Corporation (NHK)
nhk

// nico : 2014-12-04 DWANGO Co., Ltd.
nico

// nike : 2015-07-23 NIKE, Inc.
nike

// nikon : 2015-05-21 NIKON CORPORATION
nikon

// ninja : 2013-11-07 Dog Beach, LLC
ninja

// nissan : 2014-03-27 NISSAN MOTOR CO., LTD.
nissan

// nissay : 2015-10-29 Nippon Life Insurance Company
nissay

// nokia : 2015-01-08 Nokia Corporation
nokia

// northwesternmutual : 2015-06-18 Northwestern Mutual Registry, LLC
northwesternmutual

// norton : 2014-12-04 NortonLifeLock Inc.
norton

// now : 2015-06-25 Amazon Registry Services, Inc.
now

// nowruz : 2014-09-04 Asia Green IT System Bilgisayar San. ve Tic. Ltd. Sti.
nowruz

// nowtv : 2015-05-14 Starbucks (HK) Limited
nowtv

// nra : 2014-05-22 NRA Holdings Company, INC.
nra

// nrw : 2013-11-21 Minds + Machines GmbH
nrw

// ntt : 2014-10-31 NIPPON TELEGRAPH AND TELEPHONE CORPORATION
ntt

// nyc : 2014-01-23 The City of New York by and through the New York City Department of Information Technology & Telecommunications
nyc

// obi : 2014-09-25 OBI Group Holding SE & Co. KGaA
obi

// observer : 2015-04-30 Dog Beach, LLC
observer

// off : 2015-07-23 Johnson Shareholdings, Inc.
off

// office : 2015-03-12 Microsoft Corporation
office

// okinawa : 2013-12-05 BRregistry, Inc.
okinawa

// olayan : 2015-05-14 Crescent Holding GmbH
olayan

// olayangroup : 2015-05-14 Crescent Holding GmbH
olayangroup

// oldnavy : 2015-07-31 The Gap, Inc.
oldnavy

// ollo : 2015-06-04 Dish DBS Corporation
ollo

// omega : 2015-01-08 The Swatch Group Ltd
omega

// one : 2014-11-07 One.com A/S
one

// ong : 2014-03-06 Public Interest Registry
ong

// onl : 2013-09-16 iRegistry GmbH
onl

// online : 2015-01-15 Radix FZC
online

// ooo : 2014-01-09 INFIBEAM AVENUES LIMITED
ooo

// open : 2015-07-31 American Express Travel Related Services Company, Inc.
open

// oracle : 2014-06-19 Oracle Corporation
oracle

// orange : 2015-03-12 Orange Brand Services Limited
orange

// organic : 2014-03-27 Afilias Limited
organic

// origins : 2015-10-01 The Estée Lauder Companies Inc.
origins

// osaka : 2014-09-04 Osaka Registry Co., Ltd.
osaka

// otsuka : 2013-10-11 Otsuka Holdings Co., Ltd.
otsuka

// ott : 2015-06-04 Dish DBS Corporation
ott

// ovh : 2014-01-16 MédiaBC
ovh

// page : 2014-12-04 Charleston Road Registry Inc.
page

// panasonic : 2015-07-30 Panasonic Corporation
panasonic

// paris : 2014-01-30 City of Paris
paris

// pars : 2014-09-04 Asia Green IT System Bilgisayar San. ve Tic. Ltd. Sti.
pars

// partners : 2013-12-05 Binky Moon, LLC
partners

// parts : 2013-12-05 Binky Moon, LLC
parts

// party : 2014-09-11 Blue Sky Registry Limited
party

// passagens : 2015-03-05 Travel Reservations SRL
passagens

// pay : 2015-08-27 Amazon Registry Services, Inc.
pay

// pccw : 2015-05-14 PCCW Enterprises Limited
pccw

// pet : 2015-05-07 Afilias Limited
pet

// pfizer : 2015-09-11 Pfizer Inc.
pfizer

// pharmacy : 2014-06-19 National Association of Boards of Pharmacy
pharmacy

// phd : 2016-07-28 Charleston Road Registry Inc.
phd

// philips : 2014-11-07 Koninklijke Philips N.V.
philips

// phone : 2016-06-02 Dish DBS Corporation
phone

// photo : 2013-11-14 UNR Corp.
photo

// photography : 2013-09-20 Binky Moon, LLC
photography

// photos : 2013-10-17 Binky Moon, LLC
photos

// physio : 2014-05-01 PhysBiz Pty Ltd
physio

// pics : 2013-11-14 UNR Corp.
pics

// pictet : 2014-06-26 Pictet Europe S.A.
pictet

// pictures : 2014-03-06 Binky Moon, LLC
pictures

// pid : 2015-01-08 Top Level Spectrum, Inc.
pid

// pin : 2014-12-18 Amazon Registry Services, Inc.
pin

// ping : 2015-06-11 Ping Registry Provider, Inc.
ping

// pink : 2013-10-01 Afilias Limited
pink

// pioneer : 2015-07-16 Pioneer Corporation
pioneer

// pizza : 2014-06-26 Binky Moon, LLC
pizza

// place : 2014-04-24 Binky Moon, LLC
place

// play : 2015-03-05 Charleston Road Registry Inc.
play

// playstation : 2015-07-02 Sony Interactive Entertainment Inc.
playstation

// plumbing : 2013-09-10 Binky Moon, LLC
plumbing

// plus : 2015-02-05 Binky Moon, LLC
plus

// pnc : 2015-07-02 PNC Domain Co., LLC
pnc

// pohl : 2014-06-23 Deutsche Vermögensberatung Aktiengesellschaft DVAG
pohl

// poker : 2014-07-03 Afilias Limited
poker

// politie : 2015-08-20 Politie Nederland
politie

// porn : 2014-10-16 ICM Registry PN LLC
porn

// pramerica : 2015-07-30 Prudential Financial, Inc.
pramerica

// praxi : 2013-12-05 Praxi S.p.A.
praxi

// press : 2014-04-03 Radix FZC
press

// prime : 2015-06-25 Amazon Registry Services, Inc.
prime

// prod : 2014-01-23 Charleston Road Registry Inc.
prod

// productions : 2013-12-05 Binky Moon, LLC
productions

// prof : 2014-07-24 Charleston Road Registry Inc.
prof

// progressive : 2015-07-23 Progressive Casualty Insurance Company
progressive

// promo : 2014-12-18 Afilias Limited
promo

// properties : 2013-12-05 Binky Moon, LLC
properties

// property : 2014-05-22 UNR Corp.
property

// protection : 2015-04-23 XYZ.COM LLC
protection

// pru : 2015-07-30 Prudential Financial, Inc.
pru

// prudential : 2015-07-30 Prudential Financial, Inc.
prudential

// pub : 2013-12-12 Dog Beach, LLC
pub

// pwc : 2015-10-29 PricewaterhouseCoopers LLP
pwc

// qpon : 2013-11-14 dotCOOL, Inc.
qpon

// quebec : 2013-12-19 PointQuébec Inc
quebec

// quest : 2015-03-26 XYZ.COM LLC
quest

// qvc : 2015-07-30 QVC, Inc.
qvc

// racing : 2014-12-04 Premier Registry Limited
racing

// radio : 2016-07-21 European Broadcasting Union (EBU)
radio

// raid : 2015-07-23 Johnson Shareholdings, Inc.
raid

// read : 2014-12-18 Amazon Registry Services, Inc.
read

// realestate : 2015-09-11 dotRealEstate LLC
realestate

// realtor : 2014-05-29 Real Estate Domains LLC
realtor

// realty : 2015-03-19 Dog Beach, LLC
realty

// recipes : 2013-10-17 Binky Moon, LLC
recipes

// red : 2013-11-07 Afilias Limited
red

// redstone : 2014-10-31 Redstone Haute Couture Co., Ltd.
redstone

// redumbrella : 2015-03-26 Travelers TLD, LLC
redumbrella

// rehab : 2014-03-06 Dog Beach, LLC
rehab

// reise : 2014-03-13 Binky Moon, LLC
reise

// reisen : 2014-03-06 Binky Moon, LLC
reisen

// reit : 2014-09-04 National Association of Real Estate Investment Trusts, Inc.
reit

// reliance : 2015-04-02 Reliance Industries Limited
reliance

// ren : 2013-12-12 ZDNS International Limited
ren

// rent : 2014-12-04 XYZ.COM LLC
rent

// rentals : 2013-12-05 Binky Moon, LLC
rentals

// repair : 2013-11-07 Binky Moon, LLC
repair

// report : 2013-12-05 Binky Moon, LLC
report

// republican : 2014-03-20 Dog Beach, LLC
republican

// rest : 2013-12-19 Punto 2012 Sociedad Anonima Promotora de Inversion de Capital Variable
rest

// restaurant : 2014-07-03 Binky Moon, LLC
restaurant

// review : 2014-11-20 dot Review Limited
review

// reviews : 2013-09-13 Dog Beach, LLC
reviews

// rexroth : 2015-06-18 Robert Bosch GMBH
rexroth

// rich : 2013-11-21 iRegistry GmbH
rich

// richardli : 2015-05-14 Pacific Century Asset Management (HK) Limited
richardli

// ricoh : 2014-11-20 Ricoh Company, Ltd.
ricoh

// ril : 2015-04-02 Reliance Industries Limited
ril

// rio : 2014-02-27 Empresa Municipal de Informática SA - IPLANRIO
rio

// rip : 2014-07-10 Dog Beach, LLC
rip

// rmit : 2015-11-19 Royal Melbourne Institute of Technology
rmit

// rocher : 2014-12-18 Ferrero Trading Lux S.A.
rocher

// rocks : 2013-11-14 Dog Beach, LLC
rocks

// rodeo : 2013-12-19 Registry Services, LLC
rodeo

// rogers : 2015-08-06 Rogers Communications Canada Inc.
rogers

// room : 2014-12-18 Amazon Registry Services, Inc.
room

// rsvp : 2014-05-08 Charleston Road Registry Inc.
rsvp

// rugby : 2016-12-15 World Rugby Strategic Developments Limited
rugby

// ruhr : 2013-10-02 regiodot GmbH & Co. KG
ruhr

// run : 2015-03-19 Binky Moon, LLC
run

// rwe : 2015-04-02 RWE AG
rwe

// ryukyu : 2014-01-09 BRregistry, Inc.
ryukyu

// saarland : 2013-12-12 dotSaarland GmbH
saarland

// safe : 2014-12-18 Amazon Registry Services, Inc.
safe

// safety : 2015-01-08 Safety Registry Services, LLC.
safety

// sakura : 2014-12-18 SAKURA Internet Inc.
sakura

// sale : 2014-10-16 Dog Beach, LLC
sale

// salon : 2014-12-11 Binky Moon, LLC
salon

// samsclub : 2015-07-31 Wal-Mart Stores, Inc.
samsclub

// samsung : 2014-04-03 SAMSUNG SDS CO., LTD
samsung

// sandvik : 2014-11-13 Sandvik AB
sandvik

// sandvikcoromant : 2014-11-07 Sandvik AB
sandvikcoromant

// sanofi : 2014-10-09 Sanofi
sanofi

// sap : 2014-03-27 SAP AG
sap

// sarl : 2014-07-03 Binky Moon, LLC
sarl

// sas : 2015-04-02 Research IP LLC
sas

// save : 2015-06-25 Amazon Registry Services, Inc.
save

// saxo : 2014-10-31 Saxo Bank A/S
saxo

// sbi : 2015-03-12 STATE BANK OF INDIA
sbi

// sbs : 2014-11-07 ShortDot SA
sbs

// sca : 2014-03-13 SVENSKA CELLULOSA AKTIEBOLAGET SCA (publ)
sca

// scb : 2014-02-20 The Siam Commercial Bank Public Company Limited ("SCB")
scb

// schaeffler : 2015-08-06 Schaeffler Technologies AG & Co. KG
schaeffler

// schmidt : 2014-04-03 SCHMIDT GROUPE S.A.S.
schmidt

// scholarships : 2014-04-24 Scholarships.com, LLC
scholarships

// school : 2014-12-18 Binky Moon, LLC
school

// schule : 2014-03-06 Binky Moon, LLC
schule

// schwarz : 2014-09-18 Schwarz Domains und Services GmbH & Co. KG
schwarz

// science : 2014-09-11 dot Science Limited
science

// scjohnson : 2015-07-23 Johnson Shareholdings, Inc.
scjohnson

// scot : 2014-01-23 Dot Scot Registry Limited
scot

// search : 2016-06-09 Charleston Road Registry Inc.
search

// seat : 2014-05-22 SEAT, S.A. (Sociedad Unipersonal)
seat

// secure : 2015-08-27 Amazon Registry Services, Inc.
secure

// security : 2015-05-14 XYZ.COM LLC
security

// seek : 2014-12-04 Seek Limited
seek

// select : 2015-10-08 Registry Services, LLC
select

// sener : 2014-10-24 Sener Ingeniería y Sistemas, S.A.
sener

// services : 2014-02-27 Binky Moon, LLC
services

// ses : 2015-07-23 SES
ses

// seven : 2015-08-06 Seven West Media Ltd
seven

// sew : 2014-07-17 SEW-EURODRIVE GmbH & Co KG
sew

// sex : 2014-11-13 ICM Registry SX LLC
sex

// sexy : 2013-09-11 UNR Corp.
sexy

// sfr : 2015-08-13 Societe Francaise du Radiotelephone - SFR
sfr

// shangrila : 2015-09-03 Shangri‐La International Hotel Management Limited
shangrila

// sharp : 2014-05-01 Sharp Corporation
sharp

// shaw : 2015-04-23 Shaw Cablesystems G.P.
shaw

// shell : 2015-07-30 Shell Information Technology International Inc
shell

// shia : 2014-09-04 Asia Green IT System Bilgisayar San. ve Tic. Ltd. Sti.
shia

// shiksha : 2013-11-14 Afilias Limited
shiksha

// shoes : 2013-10-02 Binky Moon, LLC
shoes

// shop : 2016-04-08 GMO Registry, Inc.
shop

// shopping : 2016-03-31 Binky Moon, LLC
shopping

// shouji : 2015-01-08 Beijing Qihu Keji Co., Ltd.
shouji

// show : 2015-03-05 Binky Moon, LLC
show

// showtime : 2015-08-06 CBS Domains Inc.
showtime

// silk : 2015-06-25 Amazon Registry Services, Inc.
silk

// sina : 2015-03-12 Sina Corporation
sina

// singles : 2013-08-27 Binky Moon, LLC
singles

// site : 2015-01-15 Radix FZC
site

// ski : 2015-04-09 Afilias Limited
ski

// skin : 2015-01-15 XYZ.COM LLC
skin

// sky : 2014-06-19 Sky International AG
sky

// skype : 2014-12-18 Microsoft Corporation
skype

// sling : 2015-07-30 DISH Technologies L.L.C.
sling

// smart : 2015-07-09 Smart Communications, Inc. (SMART)
smart

// smile : 2014-12-18 Amazon Registry Services, Inc.
smile

// sncf : 2015-02-19 Société Nationale des Chemins de fer Francais S N C F
sncf

// soccer : 2015-03-26 Binky Moon, LLC
soccer

// social : 2013-11-07 Dog Beach, LLC
social

// softbank : 2015-07-02 SoftBank Group Corp.
softbank

// software : 2014-03-20 Dog Beach, LLC
software

// sohu : 2013-12-19 Sohu.com Limited
sohu

// solar : 2013-11-07 Binky Moon, LLC
solar

// solutions : 2013-11-07 Binky Moon, LLC
solutions

// song : 2015-02-26 Amazon Registry Services, Inc.
song

// sony : 2015-01-08 Sony Corporation
sony

// soy : 2014-01-23 Charleston Road Registry Inc.
soy

// spa : 2019-09-19 Asia Spa and Wellness Promotion Council Limited
spa

// space : 2014-04-03 Radix FZC
space

// sport : 2017-11-16 Global Association of International Sports Federations (GAISF)
sport

// spot : 2015-02-26 Amazon Registry Services, Inc.
spot

// srl : 2015-05-07 InterNetX, Corp
srl

// stada : 2014-11-13 STADA Arzneimittel AG
stada

// staples : 2015-07-30 Staples, Inc.
staples

// star : 2015-01-08 Star India Private Limited
star

// statebank : 2015-03-12 STATE BANK OF INDIA
statebank

// statefarm : 2015-07-30 State Farm Mutual Automobile Insurance Company
statefarm

// stc : 2014-10-09 Saudi Telecom Company
stc

// stcgroup : 2014-10-09 Saudi Telecom Company
stcgroup

// stockholm : 2014-12-18 Stockholms kommun
stockholm

// storage : 2014-12-22 XYZ.COM LLC
storage

// store : 2015-04-09 Radix FZC
store

// stream : 2016-01-08 dot Stream Limited
stream

// studio : 2015-02-11 Dog Beach, LLC
studio

// study : 2014-12-11 OPEN UNIVERSITIES AUSTRALIA PTY LTD
study

// style : 2014-12-04 Binky Moon, LLC
style

// sucks : 2014-12-22 Vox Populi Registry Ltd.
sucks

// supplies : 2013-12-19 Binky Moon, LLC
supplies

// supply : 2013-12-19 Binky Moon, LLC
supply

// support : 2013-10-24 Binky Moon, LLC
support

// surf : 2014-01-09 Registry Services, LLC
surf

// surgery : 2014-03-20 Binky Moon, LLC
surgery

// suzuki : 2014-02-20 SUZUKI MOTOR CORPORATION
suzuki

// swatch : 2015-01-08 The Swatch Group Ltd
swatch

// swiftcover : 2015-07-23 Swiftcover Insurance Services Limited
swiftcover

// swiss : 2014-10-16 Swiss Confederation
swiss

// sydney : 2014-09-18 State of New South Wales, Department of Premier and Cabinet
sydney

// systems : 2013-11-07 Binky Moon, LLC
systems

// tab : 2014-12-04 Tabcorp Holdings Limited
tab

// taipei : 2014-07-10 Taipei City Government
taipei

// talk : 2015-04-09 Amazon Registry Services, Inc.
talk

// taobao : 2015-01-15 Alibaba Group Holding Limited
taobao

// target : 2015-07-31 Target Domain Holdings, LLC
target

// tatamotors : 2015-03-12 Tata Motors Ltd
tatamotors

// tatar : 2014-04-24 Limited Liability Company "Coordination Center of Regional Domain of Tatarstan Republic"
tatar

// tattoo : 2013-08-30 UNR Corp.
tattoo

// tax : 2014-03-20 Binky Moon, LLC
tax

// taxi : 2015-03-19 Binky Moon, LLC
taxi

// tci : 2014-09-12 Asia Green IT System Bilgisayar San. ve Tic. Ltd. Sti.
tci

// tdk : 2015-06-11 TDK Corporation
tdk

// team : 2015-03-05 Binky Moon, LLC
team

// tech : 2015-01-30 Radix FZC
tech

// technology : 2013-09-13 Binky Moon, LLC
technology

// temasek : 2014-08-07 Temasek Holdings (Private) Limited
temasek

// tennis : 2014-12-04 Binky Moon, LLC
tennis

// teva : 2015-07-02 Teva Pharmaceutical Industries Limited
teva

// thd : 2015-04-02 Home Depot Product Authority, LLC
thd

// theater : 2015-03-19 Binky Moon, LLC
theater

// theatre : 2015-05-07 XYZ.COM LLC
theatre

// tiaa : 2015-07-23 Teachers Insurance and Annuity Association of America
tiaa

// tickets : 2015-02-05 XYZ.COM LLC
tickets

// tienda : 2013-11-14 Binky Moon, LLC
tienda

// tiffany : 2015-01-30 Tiffany and Company
tiffany

// tips : 2013-09-20 Binky Moon, LLC
tips

// tires : 2014-11-07 Binky Moon, LLC
tires

// tirol : 2014-04-24 punkt Tirol GmbH
tirol

// tjmaxx : 2015-07-16 The TJX Companies, Inc.
tjmaxx

// tjx : 2015-07-16 The TJX Companies, Inc.
tjx

// tkmaxx : 2015-07-16 The TJX Companies, Inc.
tkmaxx

// tmall : 2015-01-15 Alibaba Group Holding Limited
tmall

// today : 2013-09-20 Binky Moon, LLC
today

// tokyo : 2013-11-13 GMO Registry, Inc.
tokyo

// tools : 2013-11-21 Binky Moon, LLC
tools

// top : 2014-03-20 .TOP Registry
top

// toray : 2014-12-18 Toray Industries, Inc.
toray

// toshiba : 2014-04-10 TOSHIBA Corporation
toshiba

// total : 2015-08-06 Total SA
total

// tours : 2015-01-22 Binky Moon, LLC
tours

// town : 2014-03-06 Binky Moon, LLC
town

// toyota : 2015-04-23 TOYOTA MOTOR CORPORATION
toyota

// toys : 2014-03-06 Binky Moon, LLC
toys

// trade : 2014-01-23 Elite Registry Limited
trade

// trading : 2014-12-11 Dog Beach, LLC
trading

// training : 2013-11-07 Binky Moon, LLC
training

// travel : 2015-10-09 Dog Beach, LLC
travel

// travelchannel : 2015-07-02 Lifestyle Domain Holdings, Inc.
travelchannel

// travelers : 2015-03-26 Travelers TLD, LLC
travelers

// travelersinsurance : 2015-03-26 Travelers TLD, LLC
travelersinsurance

// trust : 2014-10-16 UNR Corp.
trust

// trv : 2015-03-26 Travelers TLD, LLC
trv

// tube : 2015-06-11 Latin American Telecom LLC
tube

// tui : 2014-07-03 TUI AG
tui

// tunes : 2015-02-26 Amazon Registry Services, Inc.
tunes

// tushu : 2014-12-18 Amazon Registry Services, Inc.
tushu

// tvs : 2015-02-19 T V SUNDRAM IYENGAR  & SONS LIMITED
tvs

// ubank : 2015-08-20 National Australia Bank Limited
ubank

// ubs : 2014-12-11 UBS AG
ubs

// unicom : 2015-10-15 China United Network Communications Corporation Limited
unicom

// university : 2014-03-06 Binky Moon, LLC
university

// uno : 2013-09-11 Radix FZC
uno

// uol : 2014-05-01 UBN INTERNET LTDA.
uol

// ups : 2015-06-25 UPS Market Driver, Inc.
ups

// vacations : 2013-12-05 Binky Moon, LLC
vacations

// vana : 2014-12-11 Lifestyle Domain Holdings, Inc.
vana

// vanguard : 2015-09-03 The Vanguard Group, Inc.
vanguard

// vegas : 2014-01-16 Dot Vegas, Inc.
vegas

// ventures : 2013-08-27 Binky Moon, LLC
ventures

// verisign : 2015-08-13 VeriSign, Inc.
verisign

// versicherung : 2014-03-20 tldbox GmbH
versicherung

// vet : 2014-03-06 Dog Beach, LLC
vet

// viajes : 2013-10-17 Binky Moon, LLC
viajes

// video : 2014-10-16 Dog Beach, LLC
video

// vig : 2015-05-14 VIENNA INSURANCE GROUP AG Wiener Versicherung Gruppe
vig

// viking : 2015-04-02 Viking River Cruises (Bermuda) Ltd.
viking

// villas : 2013-12-05 Binky Moon, LLC
villas

// vin : 2015-06-18 Binky Moon, LLC
vin

// vip : 2015-01-22 Registry Services, LLC
vip

// virgin : 2014-09-25 Virgin Enterprises Limited
virgin

// visa : 2015-07-30 Visa Worldwide Pte. Limited
visa

// vision : 2013-12-05 Binky Moon, LLC
vision

// viva : 2014-11-07 Saudi Telecom Company
viva

// vivo : 2015-07-31 Telefonica Brasil S.A.
vivo

// vlaanderen : 2014-02-06 DNS.be vzw
vlaanderen

// vodka : 2013-12-19 Registry Services, LLC
vodka

// volkswagen : 2015-05-14 Volkswagen Group of America Inc.
volkswagen

// volvo : 2015-11-12 Volvo Holding Sverige Aktiebolag
volvo

// vote : 2013-11-21 Monolith Registry LLC
vote

// voting : 2013-11-13 Valuetainment Corp.
voting

// voto : 2013-11-21 Monolith Registry LLC
voto

// voyage : 2013-08-27 Binky Moon, LLC
voyage

// vuelos : 2015-03-05 Travel Reservations SRL
vuelos

// wales : 2014-05-08 Nominet UK
wales

// walmart : 2015-07-31 Wal-Mart Stores, Inc.
walmart

// walter : 2014-11-13 Sandvik AB
walter

// wang : 2013-10-24 Zodiac Wang Limited
wang

// wanggou : 2014-12-18 Amazon Registry Services, Inc.
wanggou

// watch : 2013-11-14 Binky Moon, LLC
watch

// watches : 2014-12-22 Afilias Limited
watches

// weather : 2015-01-08 International Business Machines Corporation
weather

// weatherchannel : 2015-03-12 International Business Machines Corporation
weatherchannel

// webcam : 2014-01-23 dot Webcam Limited
webcam

// weber : 2015-06-04 Saint-Gobain Weber SA
weber

// website : 2014-04-03 Radix FZC
website

// wedding : 2014-04-24 Registry Services, LLC
wedding

// weibo : 2015-03-05 Sina Corporation
weibo

// weir : 2015-01-29 Weir Group IP Limited
weir

// whoswho : 2014-02-20 Who's Who Registry
whoswho

// wien : 2013-10-28 punkt.wien GmbH
wien

// wiki : 2013-11-07 Top Level Design, LLC
wiki

// williamhill : 2014-03-13 William Hill Organization Limited
williamhill

// win : 2014-11-20 First Registry Limited
win

// windows : 2014-12-18 Microsoft Corporation
windows

// wine : 2015-06-18 Binky Moon, LLC
wine

// winners : 2015-07-16 The TJX Companies, Inc.
winners

// wme : 2014-02-13 William Morris Endeavor Entertainment, LLC
wme

// wolterskluwer : 2015-08-06 Wolters Kluwer N.V.
wolterskluwer

// woodside : 2015-07-09 Woodside Petroleum Limited
woodside

// work : 2013-12-19 Registry Services, LLC
work

// works : 2013-11-14 Binky Moon, LLC
works

// world : 2014-06-12 Binky Moon, LLC
world

// wow : 2015-10-08 Amazon Registry Services, Inc.
wow

// wtc : 2013-12-19 World Trade Centers Association, Inc.
wtc

// wtf : 2014-03-06 Binky Moon, LLC
wtf

// xbox : 2014-12-18 Microsoft Corporation
xbox

// xerox : 2014-10-24 Xerox DNHC LLC
xerox

// xfinity : 2015-07-09 Comcast IP Holdings I, LLC
xfinity

// xihuan : 2015-01-08 Beijing Qihu Keji Co., Ltd.
xihuan

// xin : 2014-12-11 Elegant Leader Limited
xin

// xn--11b4c3d : 2015-01-15 VeriSign Sarl
xn--11b4c3d

// xn--1ck2e1b : 2015-02-26 Amazon Registry Services, Inc.
xn--1ck2e1b

// xn--1qqw23a : 2014-01-09 Guangzhou YU Wei Information Technology Co., Ltd.
xn--1qqw23a

// xn--30rr7y : 2014-06-12 Excellent First Limited
xn--30rr7y

// xn--3bst00m : 2013-09-13 Eagle Horizon Limited
xn--3bst00m

// xn--3ds443g : 2013-09-08 TLD REGISTRY LIMITED OY
xn--3ds443g

// xn--3oq18vl8pn36a : 2015-07-02 Volkswagen (China) Investment Co., Ltd.
xn--3oq18vl8pn36a

// xn--3pxu8k : 2015-01-15 VeriSign Sarl
xn--3pxu8k

// xn--42c2d9a : 2015-01-15 VeriSign Sarl
xn--42c2d9a

// xn--45q11c : 2013-11-21 Zodiac Gemini Ltd
xn--45q11c

// xn--4gbrim : 2013-10-04 Fans TLD Limited
xn--4gbrim

// xn--55qw42g : 2013-11-08 China Organizational Name Administration Center
xn--55qw42g

// xn--55qx5d : 2013-11-14 China Internet Network Information Center (CNNIC)
xn--55qx5d

// xn--5su34j936bgsg : 2015-09-03 Shangri‐La International Hotel Management Limited
xn--5su34j936bgsg

// xn--5tzm5g : 2014-12-22 Global Website TLD Asia Limited
xn--5tzm5g

// xn--6frz82g : 2013-09-23 Afilias Limited
xn--6frz82g

// xn--6qq986b3xl : 2013-09-13 Tycoon Treasure Limited
xn--6qq986b3xl

// xn--80adxhks : 2013-12-19 Foundation for Assistance for Internet Technologies and Infrastructure Development (FAITID)
xn--80adxhks

// xn--80aqecdr1a : 2015-10-21 Pontificium Consilium de Comunicationibus Socialibus (PCCS) (Pontifical Council for Social Communication)
xn--80aqecdr1a

// xn--80asehdb : 2013-07-14 CORE Association
xn--80asehdb

// xn--80aswg : 2013-07-14 CORE Association
xn--80aswg

// xn--8y0a063a : 2015-03-26 China United Network Communications Corporation Limited
xn--8y0a063a

// xn--9dbq2a : 2015-01-15 VeriSign Sarl
xn--9dbq2a

// xn--9et52u : 2014-06-12 RISE VICTORY LIMITED
xn--9et52u

// xn--9krt00a : 2015-03-12 Sina Corporation
xn--9krt00a

// xn--b4w605ferd : 2014-08-07 Temasek Holdings (Private) Limited
xn--b4w605ferd

// xn--bck1b9a5dre4c : 2015-02-26 Amazon Registry Services, Inc.
xn--bck1b9a5dre4c

// xn--c1avg : 2013-11-14 Public Interest Registry
xn--c1avg

// xn--c2br7g : 2015-01-15 VeriSign Sarl
xn--c2br7g

// xn--cck2b3b : 2015-02-26 Amazon Registry Services, Inc.
xn--cck2b3b

// xn--cckwcxetd : 2019-12-19 Amazon Registry Services, Inc.
xn--cckwcxetd

// xn--cg4bki : 2013-09-27 SAMSUNG SDS CO., LTD
xn--cg4bki

// xn--czr694b : 2014-01-16 Internet DotTrademark Organisation Limited
xn--czr694b

// xn--czrs0t : 2013-12-19 Binky Moon, LLC
xn--czrs0t

// xn--czru2d : 2013-11-21 Zodiac Aquarius Limited
xn--czru2d

// xn--d1acj3b : 2013-11-20 The Foundation for Network Initiatives “The Smart Internet”
xn--d1acj3b

// xn--eckvdtc9d : 2014-12-18 Amazon Registry Services, Inc.
xn--eckvdtc9d

// xn--efvy88h : 2014-08-22 Guangzhou YU Wei Information Technology Co., Ltd.
xn--efvy88h

// xn--fct429k : 2015-04-09 Amazon Registry Services, Inc.
xn--fct429k

// xn--fhbei : 2015-01-15 VeriSign Sarl
xn--fhbei

// xn--fiq228c5hs : 2013-09-08 TLD REGISTRY LIMITED OY
xn--fiq228c5hs

// xn--fiq64b : 2013-10-14 CITIC Group Corporation
xn--fiq64b

// xn--fjq720a : 2014-05-22 Binky Moon, LLC
xn--fjq720a

// xn--flw351e : 2014-07-31 Charleston Road Registry Inc.
xn--flw351e

// xn--fzys8d69uvgm : 2015-05-14 PCCW Enterprises Limited
xn--fzys8d69uvgm

// xn--g2xx48c : 2015-01-30 Nawang Heli(Xiamen) Network Service Co., LTD.
xn--g2xx48c

// xn--gckr3f0f : 2015-02-26 Amazon Registry Services, Inc.
xn--gckr3f0f

// xn--gk3at1e : 2015-10-08 Amazon Registry Services, Inc.
xn--gk3at1e

// xn--hxt814e : 2014-05-15 Zodiac Taurus Limited
xn--hxt814e

// xn--i1b6b1a6a2e : 2013-11-14 Public Interest Registry
xn--i1b6b1a6a2e

// xn--imr513n : 2014-12-11 Internet DotTrademark Organisation Limited
xn--imr513n

// xn--io0a7i : 2013-11-14 China Internet Network Information Center (CNNIC)
xn--io0a7i

// xn--j1aef : 2015-01-15 VeriSign Sarl
xn--j1aef

// xn--jlq480n2rg : 2019-12-19 Amazon Registry Services, Inc.
xn--jlq480n2rg

// xn--jlq61u9w7b : 2015-01-08 Nokia Corporation
xn--jlq61u9w7b

// xn--jvr189m : 2015-02-26 Amazon Registry Services, Inc.
xn--jvr189m

// xn--kcrx77d1x4a : 2014-11-07 Koninklijke Philips N.V.
xn--kcrx77d1x4a

// xn--kput3i : 2014-02-13 Beijing RITT-Net Technology Development Co., Ltd
xn--kput3i

// xn--mgba3a3ejt : 2014-11-20 Aramco Services Company
xn--mgba3a3ejt

// xn--mgba7c0bbn0a : 2015-05-14 Crescent Holding GmbH
xn--mgba7c0bbn0a

// xn--mgbaakc7dvf : 2015-09-03 Emirates Telecommunications Corporation (trading as Etisalat)
xn--mgbaakc7dvf

// xn--mgbab2bd : 2013-10-31 CORE Association
xn--mgbab2bd

// xn--mgbca7dzdo : 2015-07-30 Abu Dhabi Systems and Information Centre
xn--mgbca7dzdo

// xn--mgbi4ecexp : 2015-10-21 Pontificium Consilium de Comunicationibus Socialibus (PCCS) (Pontifical Council for Social Communication)
xn--mgbi4ecexp

// xn--mgbt3dhd : 2014-09-04 Asia Green IT System Bilgisayar San. ve Tic. Ltd. Sti.
xn--mgbt3dhd

// xn--mk1bu44c : 2015-01-15 VeriSign Sarl
xn--mk1bu44c

// xn--mxtq1m : 2014-03-06 Net-Chinese Co., Ltd.
xn--mxtq1m

// xn--ngbc5azd : 2013-07-13 International Domain Registry Pty. Ltd.
xn--ngbc5azd

// xn--ngbe9e0a : 2014-12-04 Kuwait Finance House
xn--ngbe9e0a

// xn--ngbrx : 2015-11-12 League of Arab States
xn--ngbrx

// xn--nqv7f : 2013-11-14 Public Interest Registry
xn--nqv7f

// xn--nqv7fs00ema : 2013-11-14 Public Interest Registry
xn--nqv7fs00ema

// xn--nyqy26a : 2014-11-07 Stable Tone Limited
xn--nyqy26a

// xn--otu796d : 2017-08-06 Jiang Yu Liang Cai Technology Company Limited
xn--otu796d

// xn--p1acf : 2013-12-12 Rusnames Limited
xn--p1acf

// xn--pssy2u : 2015-01-15 VeriSign Sarl
xn--pssy2u

// xn--q9jyb4c : 2013-09-17 Charleston Road Registry Inc.
xn--q9jyb4c

// xn--qcka1pmc : 2014-07-31 Charleston Road Registry Inc.
xn--qcka1pmc

// xn--rhqv96g : 2013-09-11 Stable Tone Limited
xn--rhqv96g

// xn--rovu88b : 2015-02-26 Amazon Registry Services, Inc.
xn--rovu88b

// xn--ses554g : 2014-01-16 KNET Co., Ltd.
xn--ses554g

// xn--t60b56a : 2015-01-15 VeriSign Sarl
xn--t60b56a

// xn--tckwe : 2015-01-15 VeriSign Sarl
xn--tckwe

// xn--tiq49xqyj : 2015-10-21 Pontificium Consilium de Comunicationibus Socialibus (PCCS) (Pontifical Council for Social Communication)
xn--tiq49xqyj

// xn--unup4y : 2013-07-14 Binky Moon, LLC
xn--unup4y

// xn--vermgensberater-ctb : 2014-06-23 Deutsche Vermögensberatung Aktiengesellschaft DVAG
xn--vermgensberater-ctb

// xn--vermgensberatung-pwb : 2014-06-23 Deutsche Vermögensberatung Aktiengesellschaft DVAG
xn--vermgensberatung-pwb

// xn--vhquv : 2013-08-27 Binky Moon, LLC
xn--vhquv

// xn--vuq861b : 2014-10-16 Beijing Tele-info Network Technology Co., Ltd.
xn--vuq861b

// xn--w4r85el8fhu5dnra : 2015-04-30 Kerry Trading Co. Limited
xn--w4r85el8fhu5dnra

// xn--w4rs40l : 2015-07-30 Kerry Trading Co. Limited
xn--w4rs40l

// xn--xhq521b : 2013-11-14 Guangzhou YU Wei Information Technology Co., Ltd.
xn--xhq521b

// xn--zfr164b : 2013-11-08 China Organizational Name Administration Center
xn--zfr164b

// xyz : 2013-12-05 XYZ.COM LLC
xyz

// yachts : 2014-01-09 XYZ.COM LLC
yachts

// yahoo : 2015-04-02 Oath Inc.
yahoo

// yamaxun : 2014-12-18 Amazon Registry Services, Inc.
yamaxun

// yandex : 2014-04-10 Yandex Europe B.V.
yandex

// yodobashi : 2014-11-20 YODOBASHI CAMERA CO.,LTD.
yodobashi

// yoga : 2014-05-29 Registry Services, LLC
yoga

// yokohama : 2013-12-12 GMO Registry, Inc.
yokohama

// you : 2015-04-09 Amazon Registry Services, Inc.
you

// youtube : 2014-05-01 Charleston Road Registry Inc.
youtube

// yun : 2015-01-08 Beijing Qihu Keji Co., Ltd.
yun

// zappos : 2015-06-25 Amazon Registry Services, Inc.
zappos

// zara : 2014-11-07 Industria de Diseño Textil, S.A. (INDITEX, S.A.)
zara

// zero : 2014-12-18 Amazon Registry Services, Inc.
zero

// zip : 2014-05-08 Charleston Road Registry Inc.
zip

// zone : 2013-11-14 Binky Moon, LLC
zone

// zuerich : 2014-11-07 Kanton Zürich (Canton of Zurich)
zuerich


// ===END ICANN DOMAINS===
// ===BEGIN PRIVATE DOMAINS===
// (Note: these are in alphabetical order by company name)

// 1GB LLC : https://www.1gb.ua/
// Submitted by 1GB LLC <noc@1gb.com.ua>
cc.ua
inf.ua
ltd.ua

// 611coin : https://611project.org/
611.to

// Aaron Marais' Gitlab pages: https://lab.aaronleem.co.za
// Submitted by Aaron Marais <its_me@aaronleem.co.za>
graphox.us

// accesso Technology Group, plc. : https://accesso.com/
// Submitted by accesso Team <accessoecommerce@accesso.com>
*.devcdnaccesso.com

// Adobe : https://www.adobe.com/
// Submitted by Ian Boston <boston@adobe.com> and Lars Trieloff <trieloff@adobe.com>
adobeaemcloud.com
*.dev.adobeaemcloud.com
hlx.live
adobeaemcloud.net
hlx.page
hlx3.page

// Agnat sp. z o.o. : https://domena.pl
// Submitted by Przemyslaw Plewa <it-admin@domena.pl>
beep.pl

// alboto.ca : http://alboto.ca
// Submitted by Anton Avramov <avramov@alboto.ca>
barsy.ca

// Alces Software Ltd : http://alces-software.com
// Submitted by Mark J. Titorenko <mark.titorenko@alces-software.com>
*.compute.estate
*.alces.network

// all-inkl.com : https://all-inkl.com
// Submitted by Werner Kaltofen <wk@all-inkl.com>
kasserver.com

// Altervista: https://www.altervista.org
// Submitted by Carlo Cannas <tech_staff@altervista.it>
altervista.org

// alwaysdata : https://www.alwaysdata.com
// Submitted by Cyril <admin@alwaysdata.com>
alwaysdata.net

// Amazon CloudFront : https://aws.amazon.com/cloudfront/
// Submitted by Donavan Miller <donavanm@amazon.com>
cloudfront.net

// Amazon Elastic Compute Cloud : https://aws.amazon.com/ec2/
// Submitted by Luke Wells <psl-maintainers@amazon.com>
*.compute.amazonaws.com
*.compute-1.amazonaws.com
*.compute.amazonaws.com.cn
us-east-1.amazonaws.com

// Amazon Elastic Beanstalk : https://aws.amazon.com/elasticbeanstalk/
// Submitted by Luke Wells <psl-maintainers@amazon.com>
cn-north-1.eb.amazonaws.com.cn
cn-northwest-1.eb.amazonaws.com.cn
elasticbeanstalk.com
ap-northeast-1.elasticbeanstalk.com
ap-northeast-2.elasticbeanstalk.com
ap-northeast-3.elasticbeanstalk.com
ap-south-1.elasticbeanstalk.com
ap-southeast-1.elasticbeanstalk.com
ap-southeast-2.elasticbeanstalk.com
ca-central-1.elasticbeanstalk.com
eu-central-1.elasticbeanstalk.com
eu-west-1.elasticbeanstalk.com
eu-west-2.elasticbeanstalk.com
eu-west-3.elasticbeanstalk.com
sa-east-1.elasticbeanstalk.com
us-east-1.elasticbeanstalk.com
us-east-2.elasticbeanstalk.com
us-gov-west-1.elasticbeanstalk.com
us-west-1.elasticbeanstalk.com
us-west-2.elasticbeanstalk.com

// Amazon Elastic Load Balancing : https://aws.amazon.com/elasticloadbalancing/
// Submitted by Luke Wells <psl-maintainers@amazon.com>
*.elb.amazonaws.com
*.elb.amazonaws.com.cn

// Amazon Global Accelerator : https://aws.amazon.com/global-accelerator/
// Submitted by Daniel Massaguer <psl-maintainers@amazon.com>
awsglobalaccelerator.com

// Amazon S3 : https://aws.amazon.com/s3/
// Submitted by Luke Wells <psl-maintainers@amazon.com>
s3.amazonaws.com
s3-ap-northeast-1.amazonaws.com
s3-ap-northeast-2.amazonaws.com
s3-ap-south-1.amazonaws.com
s3-ap-southeast-1.amazonaws.com
s3-ap-southeast-2.amazonaws.com
s3-ca-central-1.amazonaws.com
s3-eu-central-1.amazonaws.com
s3-eu-west-1.amazonaws.com
s3-eu-west-2.amazonaws.com
s3-eu-west-3.amazonaws.com
s3-external-1.amazonaws.com
s3-fips-us-gov-west-1.amazonaws.com
s3-sa-east-1.amazonaws.com
s3-us-gov-west-1.amazonaws.com
s3-us-east-2.amazonaws.com
s3-us-west-1.amazonaws.com
s3-us-west-2.amazonaws.com
s3.ap-northeast-2.amazonaws.com
s3.ap-south-1.amazonaws.com
s3.cn-north-1.amazonaws.com.cn
s3.ca-central-1.amazonaws.com
s3.eu-central-1.amazonaws.com
s3.eu-west-2.amazonaws.com
s3.eu-west-3.amazonaws.com
s3.us-east-2.amazonaws.com
s3.dualstack.ap-northeast-1.amazonaws.com
s3.dualstack.ap-northeast-2.amazonaws.com
s3.dualstack.ap-south-1.amazonaws.com
s3.dualstack.ap-southeast-1.amazonaws.com
s3.dualstack.ap-southeast-2.amazonaws.com
s3.dualstack.ca-central-1.amazonaws.com
s3.dualstack.eu-central-1.amazonaws.com
s3.dualstack.eu-west-1.amazonaws.com
s3.dualstack.eu-west-2.amazonaws.com
s3.dualstack.eu-west-3.amazonaws.com
s3.dualstack.sa-east-1.amazonaws.com
s3.dualstack.us-east-1.amazonaws.com
s3.dualstack.us-east-2.amazonaws.com
s3-website-us-east-1.amazonaws.com
s3-website-us-west-1.amazonaws.com
s3-website-us-west-2.amazonaws.com
s3-website-ap-northeast-1.amazonaws.com
s3-website-ap-southeast-1.amazonaws.com
s3-website-ap-southeast-2.amazonaws.com
s3-website-eu-west-1.amazonaws.com
s3-website-sa-east-1.amazonaws.com
s3-website.ap-northeast-2.amazonaws.com
s3-website.ap-south-1.amazonaws.com
s3-website.ca-central-1.amazonaws.com
s3-website.eu-central-1.amazonaws.com
s3-website.eu-west-2.amazonaws.com
s3-website.eu-west-3.amazonaws.com
s3-website.us-east-2.amazonaws.com

// Amsterdam Wireless: https://www.amsterdamwireless.nl/
// Submitted by Imre Jonk <hostmaster@amsterdamwireless.nl>
amsw.nl

// Amune : https://amune.org/
// Submitted by Team Amune <cert@amune.org>
t3l3p0rt.net
tele.amune.org

// Apigee : https://apigee.com/
// Submitted by Apigee Security Team <security@apigee.com>
apigee.io

// Appspace : https://www.appspace.com
// Submitted by Appspace Security Team <security@appspace.com>
appspacehosted.com
appspaceusercontent.com

// Appudo UG (haftungsbeschränkt) : https://www.appudo.com
// Submitted by Alexander Hochbaum <admin@appudo.com>
appudo.net

// Aptible : https://www.aptible.com/
// Submitted by Thomas Orozco <thomas@aptible.com>
on-aptible.com

// ASEINet : https://www.aseinet.com/
// Submitted by Asei SEKIGUCHI <mail@aseinet.com>
user.aseinet.ne.jp
gv.vc
d.gv.vc

// Asociación Amigos de la Informática "Euskalamiga" : http://encounter.eus/
// Submitted by Hector Martin <marcan@euskalencounter.org>
user.party.eus

// Association potager.org : https://potager.org/
// Submitted by Lunar <jardiniers@potager.org>
pimienta.org
poivron.org
potager.org
sweetpepper.org

// ASUSTOR Inc. : http://www.asustor.com
// Submitted by Vincent Tseng <vincenttseng@asustor.com>
myasustor.com

// Atlassian : https://atlassian.com
// Submitted by Sam Smyth <devloop@atlassian.com>
cdn.prod.atlassian-dev.net

// AVM : https://avm.de
// Submitted by Andreas Weise <a.weise@avm.de>
myfritz.net

// AVStack Pte. Ltd. : https://avstack.io
// Submitted by Jasper Hugo <jasper@avstack.io>
onavstack.net

// AW AdvisorWebsites.com Software Inc : https://advisorwebsites.com
// Submitted by James Kennedy <domains@advisorwebsites.com>
*.awdev.ca
*.advisor.ws

// b-data GmbH : https://www.b-data.io
// Submitted by Olivier Benz <olivier.benz@b-data.ch>
b-data.io

// backplane : https://www.backplane.io
// Submitted by Anthony Voutas <anthony@backplane.io>
backplaneapp.io

// Balena : https://www.balena.io
// Submitted by Petros Angelatos <petrosagg@balena.io>
balena-devices.com

// University of Banja Luka : https://unibl.org
// Domains for Republic of Srpska administrative entity.
// Submitted by Marko Ivanovic <kormang@hotmail.rs>
rs.ba

// Banzai Cloud
// Submitted by Janos Matyas <info@banzaicloud.com>
*.banzai.cloud
app.banzaicloud.io
*.backyards.banzaicloud.io


// BetaInABox
// Submitted by Adrian <adrian@betainabox.com>
betainabox.com

// BinaryLane : http://www.binarylane.com
// Submitted by Nathan O'Sullivan <nathan@mammoth.com.au>
bnr.la

// Bitbucket : http://bitbucket.org
// Submitted by Andy Ortlieb <aortlieb@atlassian.com>
bitbucket.io

// Blackbaud, Inc. : https://www.blackbaud.com
// Submitted by Paul Crowder <paul.crowder@blackbaud.com>
blackbaudcdn.net

// Blatech : http://www.blatech.net
// Submitted by Luke Bratch <luke@bratch.co.uk>
of.je

// Blue Bite, LLC : https://bluebite.com
// Submitted by Joshua Weiss <admin.engineering@bluebite.com>
bluebite.io

// Boomla : https://boomla.com
// Submitted by Tibor Halter <thalter@boomla.com>
boomla.net

// Boutir : https://www.boutir.com
// Submitted by Eric Ng Ka Ka <ngkaka@boutir.com>
boutir.com

// Boxfuse : https://boxfuse.com
// Submitted by Axel Fontaine <axel@boxfuse.com>
boxfuse.io

// bplaced : https://www.bplaced.net/
// Submitted by Miroslav Bozic <security@bplaced.net>
square7.ch
bplaced.com
bplaced.de
square7.de
bplaced.net
square7.net

// Brendly : https://brendly.rs
// Submitted by Dusan Radovanovic <dusan.radovanovic@brendly.rs>
shop.brendly.rs

// BrowserSafetyMark
// Submitted by Dave Tharp <browsersafetymark.io@quicinc.com>
browsersafetymark.io

// Bytemark Hosting : https://www.bytemark.co.uk
// Submitted by Paul Cammish <paul.cammish@bytemark.co.uk>
uk0.bigv.io
dh.bytemark.co.uk
vm.bytemark.co.uk

// Caf.js Labs LLC : https://www.cafjs.com
// Submitted by Antonio Lain <antlai@cafjs.com>
cafjs.com

// callidomus : https://www.callidomus.com/
// Submitted by Marcus Popp <admin@callidomus.com>
mycd.eu

// Carrd : https://carrd.co
// Submitted by AJ <aj@carrd.co>
drr.ac
uwu.ai
carrd.co
crd.co
ju.mp

// CentralNic : http://www.centralnic.com/names/domains
// Submitted by registry <gavin.brown@centralnic.com>
ae.org
br.com
cn.com
com.de
com.se
de.com
eu.com
gb.net
hu.net
jp.net
jpn.com
mex.com
ru.com
sa.com
se.net
uk.com
uk.net
us.com
za.bz
za.com

// No longer operated by CentralNic, these entries should be adopted and/or removed by current operators
// Submitted by Gavin Brown <gavin.brown@centralnic.com>
ar.com
gb.com
hu.com
kr.com
no.com
qc.com
uy.com

// Africa.com Web Solutions Ltd : https://registry.africa.com
// Submitted by Gavin Brown <gavin.brown@centralnic.com>
africa.com

// iDOT Services Limited : http://www.domain.gr.com
// Submitted by Gavin Brown <gavin.brown@centralnic.com>
gr.com

// Radix FZC : http://domains.in.net
// Submitted by Gavin Brown <gavin.brown@centralnic.com>
in.net
web.in

// US REGISTRY LLC : http://us.org
// Submitted by Gavin Brown <gavin.brown@centralnic.com>
us.org

// co.com Registry, LLC : https://registry.co.com
// Submitted by Gavin Brown <gavin.brown@centralnic.com>
co.com

// Roar Domains LLC : https://roar.basketball/
// Submitted by Gavin Brown <gavin.brown@centralnic.com>
aus.basketball
nz.basketball

// BRS Media : https://brsmedia.com/
// Submitted by Gavin Brown <gavin.brown@centralnic.com>
radio.am
radio.fm

// c.la : http://www.c.la/
c.la

// certmgr.org : https://certmgr.org
// Submitted by B. Blechschmidt <hostmaster@certmgr.org>
certmgr.org

// Cityhost LLC  : https://cityhost.ua
// Submitted by Maksym Rivtin <support@cityhost.net.ua>
cx.ua

// Civilized Discourse Construction Kit, Inc. : https://www.discourse.org/
// Submitted by Rishabh Nambiar & Michael Brown <team@discourse.org>
discourse.group
discourse.team

// ClearVox : http://www.clearvox.nl/
// Submitted by Leon Rowland <leon@clearvox.nl>
virtueeldomein.nl

// Clever Cloud : https://www.clever-cloud.com/
// Submitted by Quentin Adam <noc@clever-cloud.com>
cleverapps.io

// Clerk : https://www.clerk.dev
// Submitted by Colin Sidoti <systems@clerk.dev>
*.lcl.dev
*.lclstage.dev
*.stg.dev
*.stgstage.dev

// Clic2000 : https://clic2000.fr
// Submitted by Mathilde Blanchemanche <mathilde@clic2000.fr>
clic2000.net

// ClickRising : https://clickrising.com/
// Submitted by Umut Gumeli <infrastructure-publicsuffixlist@clickrising.com>
clickrising.net

// Cloud66 : https://www.cloud66.com/
// Submitted by Khash Sajadi <khash@cloud66.com>
c66.me
cloud66.ws
cloud66.zone

// CloudAccess.net : https://www.cloudaccess.net/
// Submitted by Pawel Panek <noc@cloudaccess.net>
jdevcloud.com
wpdevcloud.com
cloudaccess.host
freesite.host
cloudaccess.net

// cloudControl : https://www.cloudcontrol.com/
// Submitted by Tobias Wilken <tw@cloudcontrol.com>
cloudcontrolled.com
cloudcontrolapp.com

// Cloudera, Inc. : https://www.cloudera.com/
// Submitted by Philip Langdale <security@cloudera.com>
cloudera.site

// Cloudflare, Inc. : https://www.cloudflare.com/
// Submitted by Cloudflare Team <publicsuffixlist@cloudflare.com>
pages.dev
trycloudflare.com
workers.dev

// Clovyr : https://clovyr.io
// Submitted by Patrick Nielsen <patrick@clovyr.io>
wnext.app

// co.ca : http://registry.co.ca/
co.ca

// Co & Co : https://co-co.nl/
// Submitted by Govert Versluis <govert@co-co.nl>
*.otap.co

// i-registry s.r.o. : http://www.i-registry.cz/
// Submitted by Martin Semrad <semrad@i-registry.cz>
co.cz

// CDN77.com : http://www.cdn77.com
// Submitted by Jan Krpes <jan.krpes@cdn77.com>
c.cdn77.org
cdn77-ssl.net
r.cdn77.net
rsc.cdn77.org
ssl.origin.cdn77-secure.org

// Cloud DNS Ltd : http://www.cloudns.net
// Submitted by Aleksander Hristov <noc@cloudns.net>
cloudns.asia
cloudns.biz
cloudns.club
cloudns.cc
cloudns.eu
cloudns.in
cloudns.info
cloudns.org
cloudns.pro
cloudns.pw
cloudns.us

// CNPY : https://cnpy.gdn
// Submitted by Angelo Gladding <angelo@lahacker.net>
cnpy.gdn

// CoDNS B.V.
co.nl
co.no

// Combell.com : https://www.combell.com
// Submitted by Thomas Wouters <thomas.wouters@combellgroup.com>
webhosting.be
hosting-cluster.nl

// Coordination Center for TLD RU and XN--P1AI : https://cctld.ru/en/domains/domens_ru/reserved/
// Submitted by George Georgievsky <gug@cctld.ru>
ac.ru
edu.ru
gov.ru
int.ru
mil.ru
test.ru

// COSIMO GmbH : http://www.cosimo.de
// Submitted by Rene Marticke <rmarticke@cosimo.de>
dyn.cosidns.de
dynamisches-dns.de
dnsupdater.de
internet-dns.de
l-o-g-i-n.de
dynamic-dns.info
feste-ip.net
knx-server.net
static-access.net

// Craynic, s.r.o. : http://www.craynic.com/
// Submitted by Ales Krajnik <ales.krajnik@craynic.com>
realm.cz

// Cryptonomic : https://cryptonomic.net/
// Submitted by Andrew Cady <public-suffix-list@cryptonomic.net>
*.cryptonomic.net

// Cupcake : https://cupcake.io/
// Submitted by Jonathan Rudenberg <jonathan@cupcake.io>
cupcake.is

// Curv UG : https://curv-labs.de/
// Submitted by Marvin Wiesner <Marvin@curv-labs.de>
curv.dev

// Customer OCI - Oracle Dyn https://cloud.oracle.com/home https://dyn.com/dns/
// Submitted by Gregory Drake <support@dyn.com>
// Note: This is intended to also include customer-oci.com due to wildcards implicitly including the current label
*.customer-oci.com
*.oci.customer-oci.com
*.ocp.customer-oci.com
*.ocs.customer-oci.com

// cyon GmbH : https://www.cyon.ch/
// Submitted by Dominic Luechinger <dol@cyon.ch>
cyon.link
cyon.site

// Danger Science Group: https://dangerscience.com/
// Submitted by Skylar MacDonald <skylar@dangerscience.com>
fnwk.site
folionetwork.site
platform0.app

// Daplie, Inc : https://daplie.com
// Submitted by AJ ONeal <aj@daplie.com>
daplie.me
localhost.daplie.me

// Datto, Inc. : https://www.datto.com/
// Submitted by Philipp Heckel <ph@datto.com>
dattolocal.com
dattorelay.com
dattoweb.com
mydatto.com
dattolocal.net
mydatto.net

// Dansk.net : http://www.dansk.net/
// Submitted by Anani Voule <digital@digital.co.dk>
biz.dk
co.dk
firm.dk
reg.dk
store.dk

// dappnode.io : https://dappnode.io/
// Submitted by Abel Boldu / DAppNode Team <community@dappnode.io>
dyndns.dappnode.io

// dapps.earth : https://dapps.earth/
// Submitted by Daniil Burdakov <icqkill@gmail.com>
*.dapps.earth
*.bzz.dapps.earth

// Dark, Inc. : https://darklang.com
// Submitted by Paul Biggar <ops@darklang.com>
builtwithdark.com

// DataDetect, LLC. : https://datadetect.com
// Submitted by Andrew Banchich <abanchich@sceven.com>
demo.datadetect.com
instance.datadetect.com

// Datawire, Inc : https://www.datawire.io
// Submitted by Richard Li <secalert@datawire.io>
edgestack.me

// DDNS5 : https://ddns5.com
// Submitted by Cameron Elliott <cameron@cameronelliott.com>
ddns5.com

// Debian : https://www.debian.org/
// Submitted by Peter Palfrader / Debian Sysadmin Team <dsa-publicsuffixlist@debian.org>
debian.net

// Deno Land Inc : https://deno.com/
// Submitted by Luca Casonato <hostmaster@deno.com>
deno.dev
deno-staging.dev

// deSEC : https://desec.io/
// Submitted by Peter Thomassen <peter@desec.io>
dedyn.io

// DNS Africa Ltd https://dns.business
// Submitted by Calvin Browne <calvin@dns.business>
jozi.biz

// DNShome : https://www.dnshome.de/
// Submitted by Norbert Auler <mail@dnshome.de>
dnshome.de

// DotArai : https://www.dotarai.com/
// Submitted by Atsadawat Netcharadsang <atsadawat@dotarai.co.th>
online.th
shop.th

// DrayTek Corp. : https://www.draytek.com/
// Submitted by Paul Fang <mis@draytek.com>
drayddns.com

// DreamCommerce : https://shoper.pl/
// Submitted by Konrad Kotarba <konrad.kotarba@dreamcommerce.com>
shoparena.pl

// DreamHost : http://www.dreamhost.com/
// Submitted by Andrew Farmer <andrew.farmer@dreamhost.com>
dreamhosters.com

// Drobo : http://www.drobo.com/
// Submitted by Ricardo Padilha <rpadilha@drobo.com>
mydrobo.com

// Drud Holdings, LLC. : https://www.drud.com/
// Submitted by Kevin Bridges <kevin@drud.com>
drud.io
drud.us

// DuckDNS : http://www.duckdns.org/
// Submitted by Richard Harper <richard@duckdns.org>
duckdns.org

// Bip : https://bip.sh
// Submitted by Joel Kennedy <joel@bip.sh>
bip.sh

// bitbridge.net : Submitted by Craig Welch, abeliidev@gmail.com
bitbridge.net

// dy.fi : http://dy.fi/
// Submitted by Heikki Hannikainen <hessu@hes.iki.fi>
dy.fi
tunk.org

// DynDNS.com : http://www.dyndns.com/services/dns/dyndns/
dyndns-at-home.com
dyndns-at-work.com
dyndns-blog.com
dyndns-free.com
dyndns-home.com
dyndns-ip.com
dyndns-mail.com
dyndns-office.com
dyndns-pics.com
dyndns-remote.com
dyndns-server.com
dyndns-web.com
dyndns-wiki.com
dyndns-work.com
dyndns.biz
dyndns.info
dyndns.org
dyndns.tv
at-band-camp.net
ath.cx
barrel-of-knowledge.info
barrell-of-knowledge.info
better-than.tv
blogdns.com
blogdns.net
blogdns.org
blogsite.org
boldlygoingnowhere.org
broke-it.net
buyshouses.net
cechire.com
dnsalias.com
dnsalias.net
dnsalias.org
dnsdojo.com
dnsdojo.net
dnsdojo.org
does-it.net
doesntexist.com
doesntexist.org
dontexist.com
dontexist.net
dontexist.org
doomdns.com
doomdns.org
dvrdns.org
dyn-o-saur.com
dynalias.com
dynalias.net
dynalias.org
dynathome.net
dyndns.ws
endofinternet.net
endofinternet.org
endoftheinternet.org
est-a-la-maison.com
est-a-la-masion.com
est-le-patron.com
est-mon-blogueur.com
for-better.biz
for-more.biz
for-our.info
for-some.biz
for-the.biz
forgot.her.name
forgot.his.name
from-ak.com
from-al.com
from-ar.com
from-az.net
from-ca.com
from-co.net
from-ct.com
from-dc.com
from-de.com
from-fl.com
from-ga.com
from-hi.com
from-ia.com
from-id.com
from-il.com
from-in.com
from-ks.com
from-ky.com
from-la.net
from-ma.com
from-md.com
from-me.org
from-mi.com
from-mn.com
from-mo.com
from-ms.com
from-mt.com
from-nc.com
from-nd.com
from-ne.com
from-nh.com
from-nj.com
from-nm.com
from-nv.com
from-ny.net
from-oh.com
from-ok.com
from-or.com
from-pa.com
from-pr.com
from-ri.com
from-sc.com
from-sd.com
from-tn.com
from-tx.com
from-ut.com
from-va.com
from-vt.com
from-wa.com
from-wi.com
from-wv.com
from-wy.com
ftpaccess.cc
fuettertdasnetz.de
game-host.org
game-server.cc
getmyip.com
gets-it.net
go.dyndns.org
gotdns.com
gotdns.org
groks-the.info
groks-this.info
ham-radio-op.net
here-for-more.info
hobby-site.com
hobby-site.org
home.dyndns.org
homedns.org
homeftp.net
homeftp.org
homeip.net
homelinux.com
homelinux.net
homelinux.org
homeunix.com
homeunix.net
homeunix.org
iamallama.com
in-the-band.net
is-a-anarchist.com
is-a-blogger.com
is-a-bookkeeper.com
is-a-bruinsfan.org
is-a-bulls-fan.com
is-a-candidate.org
is-a-caterer.com
is-a-celticsfan.org
is-a-chef.com
is-a-chef.net
is-a-chef.org
is-a-conservative.com
is-a-cpa.com
is-a-cubicle-slave.com
is-a-democrat.com
is-a-designer.com
is-a-doctor.com
is-a-financialadvisor.com
is-a-geek.com
is-a-geek.net
is-a-geek.org
is-a-green.com
is-a-guru.com
is-a-hard-worker.com
is-a-hunter.com
is-a-knight.org
is-a-landscaper.com
is-a-lawyer.com
is-a-liberal.com
is-a-libertarian.com
is-a-linux-user.org
is-a-llama.com
is-a-musician.com
is-a-nascarfan.com
is-a-nurse.com
is-a-painter.com
is-a-patsfan.org
is-a-personaltrainer.com
is-a-photographer.com
is-a-player.com
is-a-republican.com
is-a-rockstar.com
is-a-socialist.com
is-a-soxfan.org
is-a-student.com
is-a-teacher.com
is-a-techie.com
is-a-therapist.com
is-an-accountant.com
is-an-actor.com
is-an-actress.com
is-an-anarchist.com
is-an-artist.com
is-an-engineer.com
is-an-entertainer.com
is-by.us
is-certified.com
is-found.org
is-gone.com
is-into-anime.com
is-into-cars.com
is-into-cartoons.com
is-into-games.com
is-leet.com
is-lost.org
is-not-certified.com
is-saved.org
is-slick.com
is-uberleet.com
is-very-bad.org
is-very-evil.org
is-very-good.org
is-very-nice.org
is-very-sweet.org
is-with-theband.com
isa-geek.com
isa-geek.net
isa-geek.org
isa-hockeynut.com
issmarterthanyou.com
isteingeek.de
istmein.de
kicks-ass.net
kicks-ass.org
knowsitall.info
land-4-sale.us
lebtimnetz.de
leitungsen.de
likes-pie.com
likescandy.com
merseine.nu
mine.nu
misconfused.org
mypets.ws
myphotos.cc
neat-url.com
office-on-the.net
on-the-web.tv
podzone.net
podzone.org
readmyblog.org
saves-the-whales.com
scrapper-site.net
scrapping.cc
selfip.biz
selfip.com
selfip.info
selfip.net
selfip.org
sells-for-less.com
sells-for-u.com
sells-it.net
sellsyourhome.org
servebbs.com
servebbs.net
servebbs.org
serveftp.net
serveftp.org
servegame.org
shacknet.nu
simple-url.com
space-to-rent.com
stuff-4-sale.org
stuff-4-sale.us
teaches-yoga.com
thruhere.net
traeumtgerade.de
webhop.biz
webhop.info
webhop.net
webhop.org
worse-than.tv
writesthisblog.com

// ddnss.de : https://www.ddnss.de/
// Submitted by Robert Niedziela <webmaster@ddnss.de>
ddnss.de
dyn.ddnss.de
dyndns.ddnss.de
dyndns1.de
dyn-ip24.de
home-webserver.de
dyn.home-webserver.de
myhome-server.de
ddnss.org

// Definima : http://www.definima.com/
// Submitted by Maxence Bitterli <maxence@definima.com>
definima.net
definima.io

// DigitalOcean : https://digitalocean.com/
// Submitted by Braxton Huggins <bhuggins@digitalocean.com>
ondigitalocean.app

// dnstrace.pro : https://dnstrace.pro/
// Submitted by Chris Partridge <chris@partridge.tech>
bci.dnstrace.pro

// Dynu.com : https://www.dynu.com/
// Submitted by Sue Ye <sue@dynu.com>
ddnsfree.com
ddnsgeek.com
giize.com
gleeze.com
kozow.com
loseyourip.com
ooguy.com
theworkpc.com
casacam.net
dynu.net
accesscam.org
camdvr.org
freeddns.org
mywire.org
webredirect.org
myddns.rocks
blogsite.xyz

// dynv6 : https://dynv6.com
// Submitted by Dominik Menke <dom@digineo.de>
dynv6.net

// E4YOU spol. s.r.o. : https://e4you.cz/
// Submitted by Vladimir Dudr <info@e4you.cz>
e4.cz

// eero : https://eero.com/
// Submitted by Yue Kang <eero-dynamic-dns@amazon.com>
eero.online
eero-stage.online

// Elementor : Elementor Ltd.
// Submitted by Anton Barkan <antonb@elementor.com>
elementor.cloud
elementor.cool

// En root‽ : https://en-root.org
// Submitted by Emmanuel Raviart <emmanuel@raviart.com>
en-root.fr

// Enalean SAS: https://www.enalean.com
// Submitted by Thomas Cottier <thomas.cottier@enalean.com>
mytuleap.com
tuleap-partners.com

// ECG Robotics, Inc: https://ecgrobotics.org
// Submitted by <frc1533@ecgrobotics.org>
onred.one
staging.onred.one

// One.com: https://www.one.com/
// Submitted by Jacob Bunk Nielsen <jbn@one.com>
service.one

// Enonic : http://enonic.com/
// Submitted by Erik Kaareng-Sunde <esu@enonic.com>
enonic.io
customer.enonic.io

// EU.org https://eu.org/
// Submitted by Pierre Beyssac <hostmaster@eu.org>
eu.org
al.eu.org
asso.eu.org
at.eu.org
au.eu.org
be.eu.org
bg.eu.org
ca.eu.org
cd.eu.org
ch.eu.org
cn.eu.org
cy.eu.org
cz.eu.org
de.eu.org
dk.eu.org
edu.eu.org
ee.eu.org
es.eu.org
fi.eu.org
fr.eu.org
gr.eu.org
hr.eu.org
hu.eu.org
ie.eu.org
il.eu.org
in.eu.org
int.eu.org
is.eu.org
it.eu.org
jp.eu.org
kr.eu.org
lt.eu.org
lu.eu.org
lv.eu.org
mc.eu.org
me.eu.org
mk.eu.org
mt.eu.org
my.eu.org
net.eu.org
ng.eu.org
nl.eu.org
no.eu.org
nz.eu.org
paris.eu.org
pl.eu.org
pt.eu.org
q-a.eu.org
ro.eu.org
ru.eu.org
se.eu.org
si.eu.org
sk.eu.org
tr.eu.org
uk.eu.org
us.eu.org

// Eurobyte : https://eurobyte.ru
// Submitted by Evgeniy Subbotin <e.subbotin@eurobyte.ru>
eurodir.ru

// Evennode : http://www.evennode.com/
// Submitted by Michal Kralik <support@evennode.com>
eu-1.evennode.com
eu-2.evennode.com
eu-3.evennode.com
eu-4.evennode.com
us-1.evennode.com
us-2.evennode.com
us-3.evennode.com
us-4.evennode.com

// eDirect Corp. : https://hosting.url.com.tw/
// Submitted by C.S. chang <cschang@corp.url.com.tw>
twmail.cc
twmail.net
twmail.org
mymailer.com.tw
url.tw

// Fabrica Technologies, Inc. : https://www.fabrica.dev/
// Submitted by Eric Jiang <eric@fabrica.dev>
onfabrica.com

// Facebook, Inc.
// Submitted by Peter Ruibal <public-suffix@fb.com>
apps.fbsbx.com

// FAITID : https://faitid.org/
// Submitted by Maxim Alzoba <tech.contact@faitid.org>
// https://www.flexireg.net/stat_info
ru.net
adygeya.ru
bashkiria.ru
bir.ru
cbg.ru
com.ru
dagestan.ru
grozny.ru
kalmykia.ru
kustanai.ru
marine.ru
mordovia.ru
msk.ru
mytis.ru
nalchik.ru
nov.ru
pyatigorsk.ru
spb.ru
vladikavkaz.ru
vladimir.ru
abkhazia.su
adygeya.su
aktyubinsk.su
arkhangelsk.su
armenia.su
ashgabad.su
azerbaijan.su
balashov.su
bashkiria.su
bryansk.su
bukhara.su
chimkent.su
dagestan.su
east-kazakhstan.su
exnet.su
georgia.su
grozny.su
ivanovo.su
jambyl.su
kalmykia.su
kaluga.su
karacol.su
karaganda.su
karelia.su
khakassia.su
krasnodar.su
kurgan.su
kustanai.su
lenug.su
mangyshlak.su
mordovia.su
msk.su
murmansk.su
nalchik.su
navoi.su
north-kazakhstan.su
nov.su
obninsk.su
penza.su
pokrovsk.su
sochi.su
spb.su
tashkent.su
termez.su
togliatti.su
troitsk.su
tselinograd.su
tula.su
tuva.su
vladikavkaz.su
vladimir.su
vologda.su

// Fancy Bits, LLC : http://getchannels.com
// Submitted by Aman Gupta <aman@getchannels.com>
channelsdvr.net
u.channelsdvr.net

// Fastly Inc. : http://www.fastly.com/
// Submitted by Fastly Security <security@fastly.com>
edgecompute.app
fastly-terrarium.com
fastlylb.net
map.fastlylb.net
freetls.fastly.net
map.fastly.net
a.prod.fastly.net
global.prod.fastly.net
a.ssl.fastly.net
b.ssl.fastly.net
global.ssl.fastly.net

// FASTVPS EESTI OU : https://fastvps.ru/
// Submitted by Likhachev Vasiliy <lihachev@fastvps.ru>
fastvps-server.com
fastvps.host
myfast.host
fastvps.site
myfast.space

// Fedora : https://fedoraproject.org/
// submitted by Patrick Uiterwijk <puiterwijk@fedoraproject.org>
fedorainfracloud.org
fedorapeople.org
cloud.fedoraproject.org
app.os.fedoraproject.org
app.os.stg.fedoraproject.org

// FearWorks Media Ltd. : https://fearworksmedia.co.uk
// submitted by Keith Fairley <domains@fearworksmedia.co.uk>
couk.me
ukco.me
conn.uk
copro.uk
hosp.uk

// Fermax : https://fermax.com/
// submitted by Koen Van Isterdael <k.vanisterdael@fermax.be>
mydobiss.com

// FH Muenster : https://www.fh-muenster.de
// Submitted by Robin Naundorf <r.naundorf@fh-muenster.de>
fh-muenster.io

// Filegear Inc. : https://www.filegear.com
// Submitted by Jason Zhu <jason@owtware.com>
filegear.me
filegear-au.me
filegear-de.me
filegear-gb.me
filegear-ie.me
filegear-jp.me
filegear-sg.me

// Firebase, Inc.
// Submitted by Chris Raynor <chris@firebase.com>
firebaseapp.com

// Firewebkit : https://www.firewebkit.com
// Submitted by Majid Qureshi <mqureshi@amrayn.com>
fireweb.app

// FLAP : https://www.flap.cloud
// Submitted by Louis Chemineau <louis@chmn.me>
flap.id

// fly.io: https://fly.io
// Submitted by Kurt Mackey <kurt@fly.io>
fly.dev
edgeapp.net
shw.io

// Flynn : https://flynn.io
// Submitted by Jonathan Rudenberg <jonathan@flynn.io>
flynnhosting.net

// Forgerock : https://www.forgerock.com
// Submitted by Roderick Parr <roderick.parr@forgerock.com>
forgeblocks.com
id.forgerock.io

// Framer : https://www.framer.com
// Submitted by Koen Rouwhorst <koenrh@framer.com>
framer.app
framercanvas.com

// Frusky MEDIA&PR : https://www.frusky.de
// Submitted by Victor Pupynin <hallo@frusky.de>
*.frusky.de

// RavPage : https://www.ravpage.co.il
// Submitted by Roni Horowitz <roni@responder.co.il>
ravpage.co.il

// Frederik Braun https://frederik-braun.com
// Submitted by Frederik Braun <fb@frederik-braun.com>
0e.vc

// Freebox : http://www.freebox.fr
// Submitted by Romain Fliedel <rfliedel@freebox.fr>
freebox-os.com
freeboxos.com
fbx-os.fr
fbxos.fr
freebox-os.fr
freeboxos.fr

// freedesktop.org : https://www.freedesktop.org
// Submitted by Daniel Stone <daniel@fooishbar.org>
freedesktop.org

// freemyip.com : https://freemyip.com
// Submitted by Cadence <contact@freemyip.com>
freemyip.com

// FunkFeuer - Verein zur Förderung freier Netze : https://www.funkfeuer.at
// Submitted by Daniel A. Maierhofer <vorstand@funkfeuer.at>
wien.funkfeuer.at

// Futureweb OG : http://www.futureweb.at
// Submitted by Andreas Schnederle-Wagner <schnederle@futureweb.at>
*.futurecms.at
*.ex.futurecms.at
*.in.futurecms.at
futurehosting.at
futuremailing.at
*.ex.ortsinfo.at
*.kunden.ortsinfo.at
*.statics.cloud

// GDS : https://www.gov.uk/service-manual/operations/operating-servicegovuk-subdomains
// Submitted by David Illsley <david.illsley@digital.cabinet-office.gov.uk>
service.gov.uk

// Gehirn Inc. : https://www.gehirn.co.jp/
// Submitted by Kohei YOSHIDA <tech@gehirn.co.jp>
gehirn.ne.jp
usercontent.jp

// Gentlent, Inc. : https://www.gentlent.com
// Submitted by Tom Klein <tom@gentlent.com>
gentapps.com
gentlentapis.com
lab.ms
cdn-edges.net

// Ghost Foundation : https://ghost.org
// Submitted by Matt Hanley <security@ghost.org>
ghost.io

// GignoSystemJapan: http://gsj.bz
// Submitted by GignoSystemJapan <kakutou-ec@gsj.bz>
gsj.bz

// GitHub, Inc.
// Submitted by Patrick Toomey <security@github.com>
githubusercontent.com
githubpreview.dev
github.io

// GitLab, Inc.
// Submitted by Alex Hanselka <alex@gitlab.com>
gitlab.io

// Gitplac.si - https://gitplac.si
// Submitted by Aljaž Starc <me@aljaxus.eu>
gitapp.si
gitpage.si

// Glitch, Inc : https://glitch.com
// Submitted by Mads Hartmann <mads@glitch.com>
glitch.me

// Global NOG Alliance : https://nogalliance.org/
// Submitted by Sander Steffann <sander@nogalliance.org>
nog.community

// Globe Hosting SRL : https://www.globehosting.com/
// Submitted by Gavin Brown <gavin.brown@centralnic.com>
co.ro
shop.ro

// GMO Pepabo, Inc. : https://pepabo.com/
// Submitted by dojineko <admin@pepabo.com>
lolipop.io

// GOV.UK Platform as a Service : https://www.cloud.service.gov.uk/
// Submitted by Tom Whitwell <gov-uk-paas-support@digital.cabinet-office.gov.uk>
cloudapps.digital
london.cloudapps.digital

// GOV.UK Pay : https://www.payments.service.gov.uk/
// Submitted by Richard Baker <richard.baker@digital.cabinet-office.gov.uk>
pymnt.uk

// UKHomeOffice : https://www.gov.uk/government/organisations/home-office
// Submitted by Jon Shanks <jon.shanks@digital.homeoffice.gov.uk>
homeoffice.gov.uk

// GlobeHosting, Inc.
// Submitted by Zoltan Egresi <egresi@globehosting.com>
ro.im

// GoIP DNS Services : http://www.goip.de
// Submitted by Christian Poulter <milchstrasse@goip.de>
goip.de

// Google, Inc.
// Submitted by Eduardo Vela <evn@google.com>
run.app
a.run.app
web.app
*.0emm.com
appspot.com
*.r.appspot.com
codespot.com
googleapis.com
googlecode.com
pagespeedmobilizer.com
publishproxy.com
withgoogle.com
withyoutube.com
*.gateway.dev
cloud.goog
translate.goog
cloudfunctions.net
blogspot.ae
blogspot.al
blogspot.am
blogspot.ba
blogspot.be
blogspot.bg
blogspot.bj
blogspot.ca
blogspot.cf
blogspot.ch
blogspot.cl
blogspot.co.at
blogspot.co.id
blogspot.co.il
blogspot.co.ke
blogspot.co.nz
blogspot.co.uk
blogspot.co.za
blogspot.com
blogspot.com.ar
blogspot.com.au
blogspot.com.br
blogspot.com.by
blogspot.com.co
blogspot.com.cy
blogspot.com.ee
blogspot.com.eg
blogspot.com.es
blogspot.com.mt
blogspot.com.ng
blogspot.com.tr
blogspot.com.uy
blogspot.cv
blogspot.cz
blogspot.de
blogspot.dk
blogspot.fi
blogspot.fr
blogspot.gr
blogspot.hk
blogspot.hr
blogspot.hu
blogspot.ie
blogspot.in
blogspot.is
blogspot.it
blogspot.jp
blogspot.kr
blogspot.li
blogspot.lt
blogspot.lu
blogspot.md
blogspot.mk
blogspot.mr
blogspot.mx
blogspot.my
blogspot.nl
blogspot.no
blogspot.pe
blogspot.pt
blogspot.qa
blogspot.re
blogspot.ro
blogspot.rs
blogspot.ru
blogspot.se
blogspot.sg
blogspot.si
blogspot.sk
blogspot.sn
blogspot.td
blogspot.tw
blogspot.ug
blogspot.vn

// Goupile : https://goupile.fr
// Submitted by Niels Martignene <hello@goupile.fr>
goupile.fr

// Group 53, LLC : https://www.group53.com
// Submitted by Tyler Todd <noc@nova53.net>
awsmppl.com

// GünstigBestellen : https://günstigbestellen.de
// Submitted by Furkan Akkoc <info@hendelzon.de>
xn--gnstigbestellen-zvb.de
xn--gnstigliefern-wob.de

// Hakaran group: http://hakaran.cz
// Submited by Arseniy Sokolov <security@hakaran.cz>
fin.ci
free.hr
caa.li
ua.rs
conf.se

// Handshake : https://handshake.org
// Submitted by Mike Damm <md@md.vc>
hs.zone
hs.run

// Hashbang : https://hashbang.sh
hashbang.sh

// Hasura : https://hasura.io
// Submitted by Shahidh K Muhammed <shahidh@hasura.io>
hasura.app
hasura-app.io

// Hepforge : https://www.hepforge.org
// Submitted by David Grellscheid <admin@hepforge.org>
hepforge.org

// Heroku : https://www.heroku.com/
// Submitted by Tom Maher <tmaher@heroku.com>
herokuapp.com
herokussl.com

// Hibernating Rhinos
// Submitted by Oren Eini <oren@ravendb.net>
myravendb.com
ravendb.community
ravendb.me
development.run
ravendb.run

// Hong Kong Productivity Council: https://www.hkpc.org/
// Submitted by SECaaS Team <summchan@hkpc.org>
secaas.hk

// HOSTBIP REGISTRY : https://www.hostbip.com/
// Submitted by Atanunu Igbunuroghene <publicsuffixlist@hostbip.com>
orx.biz
biz.gl
col.ng
firm.ng
gen.ng
ltd.ng
ngo.ng
edu.scot
sch.so
org.yt

// HostyHosting (hostyhosting.com)
hostyhosting.io

// Häkkinen.fi
// Submitted by Eero Häkkinen <Eero+psl@Häkkinen.fi>
xn--hkkinen-5wa.fi

// Ici la Lune : http://www.icilalune.com/
// Submitted by Simon Morvan <simon@icilalune.com>
*.moonscale.io
moonscale.net

// iki.fi
// Submitted by Hannu Aronsson <haa@iki.fi>
iki.fi

// Impertrix Solutions : <https://impertrixcdn.com>
// Submitted by Zhixiang Zhao <csuite@impertrix.com>
impertrixcdn.com
impertrix.com

// Incsub, LLC: https://incsub.com/
// Submitted by Aaron Edwards <sysadmins@incsub.com>
smushcdn.com
wphostedmail.com
wpmucdn.com
tempurl.host
wpmudev.host

// Individual Network Berlin e.V. : https://www.in-berlin.de/
// Submitted by Christian Seitz <chris@in-berlin.de>
dyn-berlin.de
in-berlin.de
in-brb.de
in-butter.de
in-dsl.de
in-dsl.net
in-dsl.org
in-vpn.de
in-vpn.net
in-vpn.org

// info.at : http://www.info.at/
biz.at
info.at

// info.cx : http://info.cx
// Submitted by Jacob Slater <whois@igloo.to>
info.cx

// Interlegis : http://www.interlegis.leg.br
// Submitted by Gabriel Ferreira <registrobr@interlegis.leg.br>
ac.leg.br
al.leg.br
am.leg.br
ap.leg.br
ba.leg.br
ce.leg.br
df.leg.br
es.leg.br
go.leg.br
ma.leg.br
mg.leg.br
ms.leg.br
mt.leg.br
pa.leg.br
pb.leg.br
pe.leg.br
pi.leg.br
pr.leg.br
rj.leg.br
rn.leg.br
ro.leg.br
rr.leg.br
rs.leg.br
sc.leg.br
se.leg.br
sp.leg.br
to.leg.br

// intermetrics GmbH : https://pixolino.com/
// Submitted by Wolfgang Schwarz <admin@intermetrics.de>
pixolino.com

// Internet-Pro, LLP: https://netangels.ru/
// Submited by Vasiliy Sheredeko <piphon@gmail.com>
na4u.ru

// iopsys software solutions AB : https://iopsys.eu/
// Submitted by Roman Azarenko <roman.azarenko@iopsys.eu>
iopsys.se

// IPiFony Systems, Inc. : https://www.ipifony.com/
// Submitted by Matthew Hardeman <mhardeman@ipifony.com>
ipifony.net

// IServ GmbH : https://iserv.eu
// Submitted by Kim-Alexander Brodowski <info@iserv.eu>
mein-iserv.de
schulserver.de
test-iserv.de
iserv.dev

// I-O DATA DEVICE, INC. : http://www.iodata.com/
// Submitted by Yuji Minagawa <domains-admin@iodata.jp>
iobb.net

// Jelastic, Inc. : https://jelastic.com/
// Submited by Ihor Kolodyuk <ik@jelastic.com>
mel.cloudlets.com.au
cloud.interhostsolutions.be
users.scale.virtualcloud.com.br
mycloud.by
alp1.ae.flow.ch
appengine.flow.ch
es-1.axarnet.cloud
diadem.cloud
vip.jelastic.cloud
jele.cloud
it1.eur.aruba.jenv-aruba.cloud
it1.jenv-aruba.cloud
keliweb.cloud
cs.keliweb.cloud
oxa.cloud
tn.oxa.cloud
uk.oxa.cloud
primetel.cloud
uk.primetel.cloud
ca.reclaim.cloud
uk.reclaim.cloud
us.reclaim.cloud
ch.trendhosting.cloud
de.trendhosting.cloud
jele.club
amscompute.com
clicketcloud.com
dopaas.com
hidora.com
paas.hosted-by-previder.com
rag-cloud.hosteur.com
rag-cloud-ch.hosteur.com
jcloud.ik-server.com
jcloud-ver-jpc.ik-server.com
demo.jelastic.com
kilatiron.com
paas.massivegrid.com
jed.wafaicloud.com
lon.wafaicloud.com
ryd.wafaicloud.com
j.scaleforce.com.cy
jelastic.dogado.eu
fi.cloudplatform.fi
demo.datacenter.fi
paas.datacenter.fi
jele.host
mircloud.host
paas.beebyte.io
sekd1.beebyteapp.io
jele.io
cloud-fr1.unispace.io
jc.neen.it
cloud.jelastic.open.tim.it
jcloud.kz
upaas.kazteleport.kz
cloudjiffy.net
fra1-de.cloudjiffy.net
west1-us.cloudjiffy.net
jls-sto1.elastx.net
jls-sto2.elastx.net
jls-sto3.elastx.net
faststacks.net
fr-1.paas.massivegrid.net
lon-1.paas.massivegrid.net
lon-2.paas.massivegrid.net
ny-1.paas.massivegrid.net
ny-2.paas.massivegrid.net
sg-1.paas.massivegrid.net
jelastic.saveincloud.net
nordeste-idc.saveincloud.net
j.scaleforce.net
jelastic.tsukaeru.net
sdscloud.pl
unicloud.pl
mircloud.ru
jelastic.regruhosting.ru
enscaled.sg
jele.site
jelastic.team
orangecloud.tn
j.layershift.co.uk
phx.enscaled.us
mircloud.us

// Jino : https://www.jino.ru
// Submitted by Sergey Ulyashin <ulyashin@jino.ru>
myjino.ru
*.hosting.myjino.ru
*.landing.myjino.ru
*.spectrum.myjino.ru
*.vps.myjino.ru

// Jotelulu S.L. : https://jotelulu.com
// Submitted by Daniel Fariña <ingenieria@jotelulu.com>
jotelulu.cloud

// Joyent : https://www.joyent.com/
// Submitted by Brian Bennett <brian.bennett@joyent.com>
*.triton.zone
*.cns.joyent.com

// JS.ORG : http://dns.js.org
// Submitted by Stefan Keim <admin@js.org>
js.org

// KaasHosting : http://www.kaashosting.nl/
// Submitted by Wouter Bakker <hostmaster@kaashosting.nl>
kaas.gg
khplay.nl

// Keyweb AG : https://www.keyweb.de
// Submitted by Martin Dannehl <postmaster@keymachine.de>
keymachine.de

// KingHost : https://king.host
// Submitted by Felipe Keller Braz <felipebraz@kinghost.com.br>
kinghost.net
uni5.net

// KnightPoint Systems, LLC : http://www.knightpoint.com/
// Submitted by Roy Keene <rkeene@knightpoint.com>
knightpoint.systems

// KUROKU LTD : https://kuroku.ltd/
// Submitted by DisposaBoy <security@oya.to>
oya.to

// Katholieke Universiteit Leuven: https://www.kuleuven.be
// Submitted by Abuse KU Leuven <abuse@kuleuven.be>
kuleuven.cloud
ezproxy.kuleuven.be

// .KRD : http://nic.krd/data/krd/Registration%20Policy.pdf
co.krd
edu.krd

// Krellian Ltd. : https://krellian.com
// Submitted by Ben Francis <ben@krellian.com>
krellian.net
webthings.io

// LCube - Professional hosting e.K. : https://www.lcube-webhosting.de
// Submitted by Lars Laehn <info@lcube.de>
git-repos.de
lcube-server.de
svn-repos.de

// Leadpages : https://www.leadpages.net
// Submitted by Greg Dallavalle <domains@leadpages.net>
leadpages.co
lpages.co
lpusercontent.com

// Lelux.fi : https://lelux.fi/
// Submitted by Lelux Admin <publisuffix@lelux.site>
lelux.site

// Lifetime Hosting : https://Lifetime.Hosting/
// Submitted by Mike Fillator <support@lifetime.hosting>
co.business
co.education
co.events
co.financial
co.network
co.place
co.technology

// Lightmaker Property Manager, Inc. : https://app.lmpm.com/
// Submitted by Greg Holland <greg.holland@lmpm.com>
app.lmpm.com

// linkyard ldt: https://www.linkyard.ch/
// Submitted by Mario Siegenthaler <mario.siegenthaler@linkyard.ch>
linkyard.cloud
linkyard-cloud.ch

// Linode : https://linode.com
// Submitted by <security@linode.com>
members.linode.com
*.nodebalancer.linode.com
*.linodeobjects.com

// LiquidNet Ltd : http://www.liquidnetlimited.com/
// Submitted by Victor Velchev <admin@liquidnetlimited.com>
we.bs

// localzone.xyz
// Submitted by Kenny Niehage <hello@yahe.sh>
localzone.xyz

// Log'in Line : https://www.loginline.com/
// Submitted by Rémi Mach <remi.mach@loginline.com>
loginline.app
loginline.dev
loginline.io
loginline.services
loginline.site

// Lõhmus Family, The
// Submitted by Heiki Lõhmus <hostmaster at lohmus dot me>
lohmus.me

// LubMAN UMCS Sp. z o.o : https://lubman.pl/
// Submitted by Ireneusz Maliszewski <ireneusz.maliszewski@lubman.pl>
krasnik.pl
leczna.pl
lubartow.pl
lublin.pl
poniatowa.pl
swidnik.pl

// Lug.org.uk : https://lug.org.uk
// Submitted by Jon Spriggs <admin@lug.org.uk>
glug.org.uk
lug.org.uk
lugs.org.uk

// Lukanet Ltd : https://lukanet.com
// Submitted by Anton Avramov <register@lukanet.com>
barsy.bg
barsy.co.uk
barsyonline.co.uk
barsycenter.com
barsyonline.com
barsy.club
barsy.de
barsy.eu
barsy.in
barsy.info
barsy.io
barsy.me
barsy.menu
barsy.mobi
barsy.net
barsy.online
barsy.org
barsy.pro
barsy.pub
barsy.shop
barsy.site
barsy.support
barsy.uk

// Magento Commerce
// Submitted by Damien Tournoud <dtournoud@magento.cloud>
*.magentosite.cloud

// May First - People Link : https://mayfirst.org/
// Submitted by Jamie McClelland <info@mayfirst.org>
mayfirst.info
mayfirst.org

// Mail.Ru Group : https://hb.cldmail.ru
// Submitted by Ilya Zaretskiy <zaretskiy@corp.mail.ru>
hb.cldmail.ru

// Mail Transfer Platform : https://www.neupeer.com
// Submitted by Li Hui <lihui@neupeer.com>
cn.vu

// Maze Play: https://www.mazeplay.com
// Submitted by Adam Humpherys <adam@mws.dev>
mazeplay.com

// mcpe.me : https://mcpe.me
// Submitted by Noa Heyl <hi@noa.dev>
mcpe.me

// McHost : https://mchost.ru
// Submitted by Evgeniy Subbotin <e.subbotin@mchost.ru>
mcdir.me
mcdir.ru
mcpre.ru
vps.mcdir.ru

// Mediatech : https://mediatech.by
// Submitted by Evgeniy Kozhuhovskiy <ugenk@mediatech.by>
mediatech.by
mediatech.dev

// Medicom Health : https://medicomhealth.com
// Submitted by Michael Olson <molson@medicomhealth.com>
hra.health

// Memset hosting : https://www.memset.com
// Submitted by Tom Whitwell <domains@memset.com>
miniserver.com
memset.net

// MetaCentrum, CESNET z.s.p.o. : https://www.metacentrum.cz/en/
// Submitted by Zdeněk Šustr <zdenek.sustr@cesnet.cz>
*.cloud.metacentrum.cz
custom.metacentrum.cz

// MetaCentrum, CESNET z.s.p.o. : https://www.metacentrum.cz/en/
// Submitted by Radim Janča <janca@cesnet.cz>
flt.cloud.muni.cz
usr.cloud.muni.cz

// Meteor Development Group : https://www.meteor.com/hosting
// Submitted by Pierre Carrier <pierre@meteor.com>
meteorapp.com
eu.meteorapp.com

// Michau Enterprises Limited : http://www.co.pl/
co.pl

// Microsoft Corporation : http://microsoft.com
// Submitted by Mitch Webster <miwebst@microsoft.com>
*.azurecontainer.io
azurewebsites.net
azure-mobile.net
cloudapp.net
azurestaticapps.net
centralus.azurestaticapps.net
eastasia.azurestaticapps.net
eastus2.azurestaticapps.net
westeurope.azurestaticapps.net
westus2.azurestaticapps.net

// minion.systems : http://minion.systems
// Submitted by Robert Böttinger <r@minion.systems>
csx.cc

// Mintere : https://mintere.com/
// Submitted by Ben Aubin <security@mintere.com>
mintere.site

// MobileEducation, LLC : https://joinforte.com
// Submitted by Grayson Martin <grayson.martin@mobileeducation.us>
forte.id

// Mozilla Corporation : https://mozilla.com
// Submitted by Ben Francis <bfrancis@mozilla.com>
mozilla-iot.org

// Mozilla Foundation : https://mozilla.org/
// Submitted by glob <glob@mozilla.com>
bmoattachments.org

// MSK-IX : https://www.msk-ix.ru/
// Submitted by Khannanov Roman <r.khannanov@msk-ix.ru>
net.ru
org.ru
pp.ru

// Mythic Beasts : https://www.mythic-beasts.com
// Submitted by Paul Cammish <kelduum@mythic-beasts.com>
hostedpi.com
customer.mythic-beasts.com
caracal.mythic-beasts.com
fentiger.mythic-beasts.com
lynx.mythic-beasts.com
ocelot.mythic-beasts.com
oncilla.mythic-beasts.com
onza.mythic-beasts.com
sphinx.mythic-beasts.com
vs.mythic-beasts.com
x.mythic-beasts.com
yali.mythic-beasts.com
cust.retrosnub.co.uk

// Nabu Casa : https://www.nabucasa.com
// Submitted by Paulus Schoutsen <infra@nabucasa.com>
ui.nabu.casa

// Names.of.London : https://names.of.london/
// Submitted by James Stevens <registry[at]names.of.london> or <publiclist[at]jrcs.net>
pony.club
of.fashion
in.london
of.london
from.marketing
with.marketing
for.men
repair.men
and.mom
for.mom
for.one
under.one
for.sale
that.win
from.work
to.work

// NCTU.ME : https://nctu.me/
// Submitted by Tocknicsu <admin@nctu.me>
nctu.me

// Netlify : https://www.netlify.com
// Submitted by Jessica Parsons <jessica@netlify.com>
netlify.app

// Neustar Inc.
// Submitted by Trung Tran <Trung.Tran@neustar.biz>
4u.com

// ngrok : https://ngrok.com/
// Submitted by Alan Shreve <alan@ngrok.com>
ngrok.io

// Nimbus Hosting Ltd. : https://www.nimbushosting.co.uk/
// Submitted by Nicholas Ford <nick@nimbushosting.co.uk>
nh-serv.co.uk

// NFSN, Inc. : https://www.NearlyFreeSpeech.NET/
// Submitted by Jeff Wheelhouse <support@nearlyfreespeech.net>
nfshost.com

// Noop : https://noop.app
// Submitted by Nathaniel Schweinberg <noop@rearc.io>
*.developer.app
noop.app

// Northflank Ltd. : https://northflank.com/
// Submitted by Marco Suter <marco@northflank.com>
*.northflank.app
*.code.run

// Noticeable : https://noticeable.io
// Submitted by Laurent Pellegrino <security@noticeable.io>
noticeable.news

// Now-DNS : https://now-dns.com
// Submitted by Steve Russell <steve@now-dns.com>
dnsking.ch
mypi.co
n4t.co
001www.com
ddnslive.com
myiphost.com
forumz.info
16-b.it
32-b.it
64-b.it
soundcast.me
tcp4.me
dnsup.net
hicam.net
now-dns.net
ownip.net
vpndns.net
dynserv.org
now-dns.org
x443.pw
now-dns.top
ntdll.top
freeddns.us
crafting.xyz
zapto.xyz

// nsupdate.info : https://www.nsupdate.info/
// Submitted by Thomas Waldmann <info@nsupdate.info>
nsupdate.info
nerdpol.ovh

// No-IP.com : https://noip.com/
// Submitted by Deven Reza <publicsuffixlist@noip.com>
blogsyte.com
brasilia.me
cable-modem.org
ciscofreak.com
collegefan.org
couchpotatofries.org
damnserver.com
ddns.me
ditchyourip.com
dnsfor.me
dnsiskinky.com
dvrcam.info
dynns.com
eating-organic.net
fantasyleague.cc
geekgalaxy.com
golffan.us
health-carereform.com
homesecuritymac.com
homesecuritypc.com
hopto.me
ilovecollege.info
loginto.me
mlbfan.org
mmafan.biz
myactivedirectory.com
mydissent.net
myeffect.net
mymediapc.net
mypsx.net
mysecuritycamera.com
mysecuritycamera.net
mysecuritycamera.org
net-freaks.com
nflfan.org
nhlfan.net
no-ip.ca
no-ip.co.uk
no-ip.net
noip.us
onthewifi.com
pgafan.net
point2this.com
pointto.us
privatizehealthinsurance.net
quicksytes.com
read-books.org
securitytactics.com
serveexchange.com
servehumour.com
servep2p.com
servesarcasm.com
stufftoread.com
ufcfan.org
unusualperson.com
workisboring.com
3utilities.com
bounceme.net
ddns.net
ddnsking.com
gotdns.ch
hopto.org
myftp.biz
myftp.org
myvnc.com
no-ip.biz
no-ip.info
no-ip.org
noip.me
redirectme.net
servebeer.com
serveblog.net
servecounterstrike.com
serveftp.com
servegame.com
servehalflife.com
servehttp.com
serveirc.com
serveminecraft.net
servemp3.com
servepics.com
servequake.com
sytes.net
webhop.me
zapto.org

// NodeArt : https://nodeart.io
// Submitted by Konstantin Nosov <Nosov@nodeart.io>
stage.nodeart.io

// Nodum B.V. : https://nodum.io/
// Submitted by Wietse Wind <hello+publicsuffixlist@nodum.io>
nodum.co
nodum.io

// Nucleos Inc. : https://nucleos.com
// Submitted by Piotr Zduniak <piotr@nucleos.com>
pcloud.host

// NYC.mn : http://www.information.nyc.mn
// Submitted by Matthew Brown <mattbrown@nyc.mn>
nyc.mn

// Observable, Inc. : https://observablehq.com
// Submitted by Mike Bostock <dns@observablehq.com>
static.observableusercontent.com

// Octopodal Solutions, LLC. : https://ulterius.io/
// Submitted by Andrew Sampson <andrew@ulterius.io>
cya.gg

// OMG.LOL : <https://omg.lol>
// Submitted by Adam Newbold <adam@omg.lol>
omg.lol

// Omnibond Systems, LLC. : https://www.omnibond.com
// Submitted by Cole Estep <cole@omnibond.com>
cloudycluster.net

// OmniWe Limited: https://omniwe.com
// Submitted by Vicary Archangel <vicary@omniwe.com>
omniwe.site

// One Fold Media : http://www.onefoldmedia.com/
// Submitted by Eddie Jones <eddie@onefoldmedia.com>
nid.io

// Open Social : https://www.getopensocial.com/
// Submitted by Alexander Varwijk <security@getopensocial.com>
opensocial.site

// OpenCraft GmbH : http://opencraft.com/
// Submitted by Sven Marnach <sven@opencraft.com>
opencraft.hosting

// OpenResearch GmbH: https://openresearch.com/
// Submitted by Philipp Schmid <ops@openresearch.com>
orsites.com

// Opera Software, A.S.A.
// Submitted by Yngve Pettersen <yngve@opera.com>
operaunite.com

// Oursky Limited : https://authgear.com/, https://skygear.io/
// Submited by Authgear Team <hello@authgear.com>, Skygear Developer <hello@skygear.io>
authgear-staging.com
authgearapps.com
skygearapp.com

// OutSystems
// Submitted by Duarte Santos <domain-admin@outsystemscloud.com>
outsystemscloud.com

// OVHcloud: https://ovhcloud.com
// Submitted by Vincent Cassé <vincent.casse@ovhcloud.com>
*.webpaas.ovh.net
*.hosting.ovh.net

// OwnProvider GmbH: http://www.ownprovider.com
// Submitted by Jan Moennich <jan.moennich@ownprovider.com>
ownprovider.com
own.pm

// OwO : https://whats-th.is/
// Submitted by Dean Sheather <dean@deansheather.com>
*.owo.codes

// OX : http://www.ox.rs
// Submitted by Adam Grand <webmaster@mail.ox.rs>
ox.rs

// oy.lc
// Submitted by Charly Coste <changaco@changaco.oy.lc>
oy.lc

// Pagefog : https://pagefog.com/
// Submitted by Derek Myers <derek@pagefog.com>
pgfog.com

// Pagefront : https://www.pagefronthq.com/
// Submitted by Jason Kriss <jason@pagefronthq.com>
pagefrontapp.com

// PageXL : https://pagexl.com
// Submitted by Yann Guichard <yann@pagexl.com>
pagexl.com

// Paywhirl, Inc : https://paywhirl.com/
// Submitted by Daniel Netzer <dan@paywhirl.com>
*.paywhirl.com

// pcarrier.ca Software Inc: https://pcarrier.ca/
// Submitted by Pierre Carrier <pc@rrier.ca>
bar0.net
bar1.net
bar2.net
rdv.to

// .pl domains (grandfathered)
art.pl
gliwice.pl
krakow.pl
poznan.pl
wroc.pl
zakopane.pl

// Pantheon Systems, Inc. : https://pantheon.io/
// Submitted by Gary Dylina <gary@pantheon.io>
pantheonsite.io
gotpantheon.com

// Peplink | Pepwave : http://peplink.com/
// Submitted by Steve Leung <steveleung@peplink.com>
mypep.link

// Perspecta : https://perspecta.com/
// Submitted by Kenneth Van Alstyne <kvanalstyne@perspecta.com>
perspecta.cloud

// PE Ulyanov Kirill Sergeevich : https://airy.host
// Submitted by Kirill Ulyanov <k.ulyanov@airy.host>
lk3.ru

// Planet-Work : https://www.planet-work.com/
// Submitted by Frédéric VANNIÈRE <f.vanniere@planet-work.com>
on-web.fr

// Platform.sh : https://platform.sh
// Submitted by Nikola Kotur <nikola@platform.sh>
bc.platform.sh
ent.platform.sh
eu.platform.sh
us.platform.sh
*.platformsh.site
*.tst.site

// Platter: https://platter.dev
// Submitted by Patrick Flor <patrick@platter.dev>
platter-app.com
platter-app.dev
platterp.us

// Plesk : https://www.plesk.com/
// Submitted by Anton Akhtyamov <program-managers@plesk.com>
pdns.page
plesk.page
pleskns.com

// Port53 : https://port53.io/
// Submitted by Maximilian Schieder <maxi@zeug.co>
dyn53.io

// Positive Codes Technology Company : http://co.bn/faq.html
// Submitted by Zulfais <pc@co.bn>
co.bn

// Postman, Inc : https://postman.com
// Submitted by Rahul Dhawan <security@postman.com>
postman-echo.com
pstmn.io
mock.pstmn.io
httpbin.org

// prgmr.com : https://prgmr.com/
// Submitted by Sarah Newman <owner@prgmr.com>
xen.prgmr.com

// priv.at : http://www.nic.priv.at/
// Submitted by registry <lendl@nic.at>
priv.at

// privacytools.io : https://www.privacytools.io/
// Submitted by Jonah Aragon <jonah@privacytools.io>
prvcy.page

// Protocol Labs : https://protocol.ai/
// Submitted by Michael Burns <noc@protocol.ai>
*.dweb.link

// Protonet GmbH : http://protonet.io
// Submitted by Martin Meier <admin@protonet.io>
protonet.io

// Publication Presse Communication SARL : https://ppcom.fr
// Submitted by Yaacov Akiba Slama <admin@chirurgiens-dentistes-en-france.fr>
chirurgiens-dentistes-en-france.fr
byen.site

// pubtls.org: https://www.pubtls.org
// Submitted by Kor Nielsen <kor@pubtls.org>
pubtls.org

// PythonAnywhere LLP: https://www.pythonanywhere.com
// Submitted by Giles Thomas <giles@pythonanywhere.com>
pythonanywhere.com
eu.pythonanywhere.com

// QOTO, Org.
// Submitted by Jeffrey Phillips Freeman <jeffrey.freeman@qoto.org>
qoto.io

// Qualifio : https://qualifio.com/
// Submitted by Xavier De Cock <xdecock@gmail.com>
qualifioapp.com

// QuickBackend: https://www.quickbackend.com
// Submitted by Dani Biro <dani@pymet.com>
qbuser.com

// Rad Web Hosting: https://radwebhosting.com
// Submitted by Scott Claeys <s.claeys@radwebhosting.com>
cloudsite.builders

// Redstar Consultants : https://www.redstarconsultants.com/
// Submitted by Jons Slemmer <jons@redstarconsultants.com>
instantcloud.cn

// Russian Academy of Sciences
// Submitted by Tech Support <support@rasnet.ru>
ras.ru

// QA2
// Submitted by Daniel Dent (https://www.danieldent.com/)
qa2.com

// QCX
// Submitted by Cassandra Beelen <cassandra@beelen.one>
qcx.io
*.sys.qcx.io

// QNAP System Inc : https://www.qnap.com
// Submitted by Nick Chang <nickchang@qnap.com>
dev-myqnapcloud.com
alpha-myqnapcloud.com
myqnapcloud.com

// Quip : https://quip.com
// Submitted by Patrick Linehan <plinehan@quip.com>
*.quipelements.com

// Qutheory LLC : http://qutheory.io
// Submitted by Jonas Schwartz <jonas@qutheory.io>
vapor.cloud
vaporcloud.io

// Rackmaze LLC : https://www.rackmaze.com
// Submitted by Kirill Pertsev <kika@rackmaze.com>
rackmaze.com
rackmaze.net

// Rakuten Games, Inc : https://dev.viberplay.io
// Submitted by Joshua Zhang <public-suffix@rgames.jp>
g.vbrplsbx.io

// Rancher Labs, Inc : https://rancher.com
// Submitted by Vincent Fiduccia <domains@rancher.com>
*.on-k3s.io
*.on-rancher.cloud
*.on-rio.io

// Read The Docs, Inc : https://www.readthedocs.org
// Submitted by David Fischer <team@readthedocs.org>
readthedocs.io

// Red Hat, Inc. OpenShift : https://openshift.redhat.com/
// Submitted by Tim Kramer <tkramer@rhcloud.com>
rhcloud.com

// Render : https://render.com
// Submitted by Anurag Goel <dev@render.com>
app.render.com
onrender.com

// Repl.it : https://repl.it
// Submitted by Mason Clayton <mason@repl.it>
repl.co
id.repl.co
repl.run

// Resin.io : https://resin.io
// Submitted by Tim Perry <tim@resin.io>
resindevice.io
devices.resinstaging.io

// RethinkDB : https://www.rethinkdb.com/
// Submitted by Chris Kastorff <info@rethinkdb.com>
hzc.io

// Revitalised Limited : http://www.revitalised.co.uk
// Submitted by Jack Price <jack@revitalised.co.uk>
wellbeingzone.eu
wellbeingzone.co.uk

// Rico Developments Limited : https://adimo.co
// Submitted by Colin Brown <hello@adimo.co>
adimo.co.uk

// Riseup Networks : https://riseup.net
// Submitted by Micah Anderson <micah@riseup.net>
itcouldbewor.se

// Rochester Institute of Technology : http://www.rit.edu/
// Submitted by Jennifer Herting <jchits@rit.edu>
git-pages.rit.edu

// Rusnames Limited: http://rusnames.ru/
// Submitted by Sergey Zotov <admin@rusnames.ru>
xn--90amc.xn--p1acf
xn--j1aef.xn--p1acf
xn--j1ael8b.xn--p1acf
xn--h1ahn.xn--p1acf
xn--j1adp.xn--p1acf
xn--c1avg.xn--p1acf
xn--80aaa0cvac.xn--p1acf
xn--h1aliz.xn--p1acf
xn--90a1af.xn--p1acf
xn--41a.xn--p1acf

// Sandstorm Development Group, Inc. : https://sandcats.io/
// Submitted by Asheesh Laroia <asheesh@sandstorm.io>
sandcats.io

// SBE network solutions GmbH : https://www.sbe.de/
// Submitted by Norman Meilick <nm@sbe.de>
logoip.de
logoip.com

// schokokeks.org GbR : https://schokokeks.org/
// Submitted by Hanno Böck <hanno@schokokeks.org>
schokokeks.net

// Scottish Government: https://www.gov.scot
// Submitted by Martin Ellis <martin.ellis@gov.scot>
gov.scot
service.gov.scot

// Scry Security : http://www.scrysec.com
// Submitted by Shante Adam <shante@skyhat.io>
scrysec.com

// Securepoint GmbH : https://www.securepoint.de
// Submitted by Erik Anders <erik.anders@securepoint.de>
firewall-gateway.com
firewall-gateway.de
my-gateway.de
my-router.de
spdns.de
spdns.eu
firewall-gateway.net
my-firewall.org
myfirewall.org
spdns.org

// Seidat : https://www.seidat.com
// Submitted by Artem Kondratev <accounts@seidat.com>
seidat.net

// Sellfy : https://sellfy.com
// Submitted by Yuriy Romadin <contact@sellfy.com>
sellfy.store

// Senseering GmbH : https://www.senseering.de
// Submitted by Felix Mönckemeyer <f.moenckemeyer@senseering.de>
senseering.net

// Sendmsg: https://www.sendmsg.co.il
// Submitted by Assaf Stern <domains@comstar.co.il>
minisite.ms

// Service Magnet : https://myservicemagnet.com
// Submitted by Dave Sanders <dave@myservicemagnet.com>
magnet.page

// Service Online LLC : http://drs.ua/
// Submitted by Serhii Bulakh <support@drs.ua>
biz.ua
co.ua
pp.ua

// Shift Crypto AG : https://shiftcrypto.ch
// Submitted by alex <alex@shiftcrypto.ch>
shiftcrypto.dev
shiftcrypto.io

// ShiftEdit : https://shiftedit.net/
// Submitted by Adam Jimenez <adam@shiftcreate.com>
shiftedit.io

// Shopblocks : http://www.shopblocks.com/
// Submitted by Alex Bowers <alex@shopblocks.com>
myshopblocks.com

// Shopify : https://www.shopify.com
// Submitted by Alex Richter <alex.richter@shopify.com>
myshopify.com

// Shopit : https://www.shopitcommerce.com/
// Submitted by Craig McMahon <craig@shopitcommerce.com>
shopitsite.com

// shopware AG : https://shopware.com
// Submitted by Jens Küper <cloud@shopware.com>
shopware.store

// Siemens Mobility GmbH
// Submitted by Oliver Graebner <security@mo-siemens.io>
mo-siemens.io

// SinaAppEngine : http://sae.sina.com.cn/
// Submitted by SinaAppEngine <saesupport@sinacloud.com>
1kapp.com
appchizi.com
applinzi.com
sinaapp.com
vipsinaapp.com

// Siteleaf : https://www.siteleaf.com/
// Submitted by Skylar Challand <support@siteleaf.com>
siteleaf.net

// Skyhat : http://www.skyhat.io
// Submitted by Shante Adam <shante@skyhat.io>
bounty-full.com
alpha.bounty-full.com
beta.bounty-full.com

// Small Technology Foundation : https://small-tech.org
// Submitted by Aral Balkan <aral@small-tech.org>
small-web.org

// Smoove.io : https://www.smoove.io/
// Submitted by Dan Kozak <dan@smoove.io>
vp4.me

// Snowplow Analytics : https://snowplowanalytics.com/
// Submitted by Ian Streeter <ian@snowplowanalytics.com>
try-snowplow.com

// SourceHut : https://sourcehut.org
// Submitted by Drew DeVault <sir@cmpwn.com>
srht.site

// Stackhero : https://www.stackhero.io
// Submitted by Adrien Gillon <adrien+public-suffix-list@stackhero.io>
stackhero-network.com

// Staclar : https://staclar.com
// Submitted by Matthias Merkel <matthias.merkel@staclar.com>
novecore.site

// staticland : https://static.land
// Submitted by Seth Vincent <sethvincent@gmail.com>
static.land
dev.static.land
sites.static.land

// Storebase : https://www.storebase.io
// Submitted by Tony Schirmer <tony@storebase.io>
storebase.store

// Strategic System Consulting (eApps Hosting): https://www.eapps.com/
// Submitted by Alex Oancea <aoancea@cloudscale365.com>
vps-host.net
atl.jelastic.vps-host.net
njs.jelastic.vps-host.net
ric.jelastic.vps-host.net

// Sony Interactive Entertainment LLC : https://sie.com/
// Submitted by David Coles <david.coles@sony.com>
playstation-cloud.com

// SourceLair PC : https://www.sourcelair.com
// Submitted by Antonis Kalipetis <akalipetis@sourcelair.com>
apps.lair.io
*.stolos.io

// SpaceKit : https://www.spacekit.io/
// Submitted by Reza Akhavan <spacekit.io@gmail.com>
spacekit.io

// SpeedPartner GmbH: https://www.speedpartner.de/
// Submitted by Stefan Neufeind <info@speedpartner.de>
customer.speedpartner.de

// Spreadshop (sprd.net AG) : https://www.spreadshop.com/
// Submitted by Martin Breest <security@spreadshop.com>
myspreadshop.at
myspreadshop.com.au
myspreadshop.be
myspreadshop.ca
myspreadshop.ch
myspreadshop.com
myspreadshop.de
myspreadshop.dk
myspreadshop.es
myspreadshop.fi
myspreadshop.fr
myspreadshop.ie
myspreadshop.it
myspreadshop.net
myspreadshop.nl
myspreadshop.no
myspreadshop.pl
myspreadshop.se
myspreadshop.co.uk

// Standard Library : https://stdlib.com
// Submitted by Jacob Lee <jacob@stdlib.com>
api.stdlib.com

// Storj Labs Inc. : https://storj.io/
// Submitted by Philip Hutchins <hostmaster@storj.io>
storj.farm

// Studenten Net Twente : http://www.snt.utwente.nl/
// Submitted by Silke Hofstra <syscom@snt.utwente.nl>
utwente.io

// Student-Run Computing Facility : https://www.srcf.net/
// Submitted by Edwin Balani <sysadmins@srcf.net>
soc.srcf.net
user.srcf.net

// Sub 6 Limited: http://www.sub6.com
// Submitted by Dan Miller <dm@sub6.com>
temp-dns.com

// Supabase : https://supabase.io
// Submitted by Inian Parameshwaran <security@supabase.io>
supabase.co
supabase.in
supabase.net
su.paba.se

// Symfony, SAS : https://symfony.com/
// Submitted by Fabien Potencier <fabien@symfony.com>
*.s5y.io
*.sensiosite.cloud

// Syncloud : https://syncloud.org
// Submitted by Boris Rybalkin <syncloud@syncloud.it>
syncloud.it

// Synology, Inc. : https://www.synology.com/
// Submitted by Rony Weng <ronyweng@synology.com>
diskstation.me
dscloud.biz
dscloud.me
dscloud.mobi
dsmynas.com
dsmynas.net
dsmynas.org
familyds.com
familyds.net
familyds.org
i234.me
myds.me
synology.me
vpnplus.to
direct.quickconnect.to

// TAIFUN Software AG : http://taifun-software.de
// Submitted by Bjoern Henke <dev-server@taifun-software.de>
taifun-dns.de

// TASK geographical domains (www.task.gda.pl/uslugi/dns)
gda.pl
gdansk.pl
gdynia.pl
med.pl
sopot.pl

// Teckids e.V. : https://www.teckids.org
// Submitted by Dominik George <dominik.george@teckids.org>
edugit.org

// Telebit : https://telebit.cloud
// Submitted by AJ ONeal <aj@telebit.cloud>
telebit.app
telebit.io
*.telebit.xyz

// The Gwiddle Foundation : https://gwiddlefoundation.org.uk
// Submitted by Joshua Bayfield <joshua.bayfield@gwiddlefoundation.org.uk>
gwiddle.co.uk

// Thingdust AG : https://thingdust.com/
// Submitted by Adrian Imboden <adi@thingdust.com>
*.firenet.ch
*.svc.firenet.ch
reservd.com
thingdustdata.com
cust.dev.thingdust.io
cust.disrec.thingdust.io
cust.prod.thingdust.io
cust.testing.thingdust.io
reservd.dev.thingdust.io
reservd.disrec.thingdust.io
reservd.testing.thingdust.io

// Tlon.io : https://tlon.io
// Submitted by Mark Staarink <mark@tlon.io>
arvo.network
azimuth.network
tlon.network

// Tor Project, Inc. : https://torproject.org
// Submitted by Antoine Beaupré <anarcat@torproject.org
torproject.net
pages.torproject.net

// TownNews.com : http://www.townnews.com
// Submitted by Dustin Ward <dward@townnews.com>
bloxcms.com
townnews-staging.com

// TradableBits: https://tradablebits.com
// Submitted by Dmitry Khrisanov dmitry@tradablebits.com
tbits.me

// TrafficPlex GmbH : https://www.trafficplex.de/
// Submitted by Phillipp Röll <phillipp.roell@trafficplex.de>
12hp.at
2ix.at
4lima.at
lima-city.at
12hp.ch
2ix.ch
4lima.ch
lima-city.ch
trafficplex.cloud
de.cool
12hp.de
2ix.de
4lima.de
lima-city.de
1337.pictures
clan.rip
lima-city.rocks
webspace.rocks
lima.zone

// TransIP : https://www.transip.nl
// Submitted by Rory Breuk <rbreuk@transip.nl>
*.transurl.be
*.transurl.eu
*.transurl.nl

// TuxFamily : http://tuxfamily.org
// Submitted by TuxFamily administrators <adm@staff.tuxfamily.org>
tuxfamily.org

// TwoDNS : https://www.twodns.de/
// Submitted by TwoDNS-Support <support@two-dns.de>
dd-dns.de
diskstation.eu
diskstation.org
dray-dns.de
draydns.de
dyn-vpn.de
dynvpn.de
mein-vigor.de
my-vigor.de
my-wan.de
syno-ds.de
synology-diskstation.de
synology-ds.de

// Uberspace : https://uberspace.de
// Submitted by Moritz Werner <mwerner@jonaspasche.com>
uber.space
*.uberspace.de

// UDR Limited : http://www.udr.hk.com
// Submitted by registry <hostmaster@udr.hk.com>
hk.com
hk.org
ltd.hk
inc.hk

// United Gameserver GmbH : https://united-gameserver.de
// Submitted by Stefan Schwarz <sysadm@united-gameserver.de>
virtualuser.de
virtual-user.de

// urown.net : https://urown.net
// Submitted by Hostmaster <hostmaster@urown.net>
urown.cloud
dnsupdate.info

// .US
// Submitted by Ed Moore <Ed.Moore@lib.de.us>
lib.de.us

// VeryPositive SIA : http://very.lv
// Submitted by Danko Aleksejevs <danko@very.lv>
2038.io

// Vercel, Inc : https://vercel.com/
// Submitted by Connor Davis <security@vercel.com>
vercel.app
vercel.dev
now.sh

// Viprinet Europe GmbH : http://www.viprinet.com
// Submitted by Simon Kissel <hostmaster@viprinet.com>
router.management

// Virtual-Info : https://www.virtual-info.info/
// Submitted by Adnan RIHAN <hostmaster@v-info.info>
v-info.info

// Voorloper.com: https://voorloper.com
// Submitted by Nathan van Bakel <info@voorloper.com>
voorloper.cloud

// Voxel.sh DNS : https://voxel.sh/dns/
// Submitted by Mia Rehlinger <dns@voxel.sh>
neko.am
nyaa.am
be.ax
cat.ax
es.ax
eu.ax
gg.ax
mc.ax
us.ax
xy.ax
nl.ci
xx.gl
app.gp
blog.gt
de.gt
to.gt
be.gy
cc.hn
blog.kg
io.kg
jp.kg
tv.kg
uk.kg
us.kg
de.ls
at.md
de.md
jp.md
to.md
indie.porn
vxl.sh
ch.tc
me.tc
we.tc
nyan.to
at.vg
blog.vu
dev.vu
me.vu

// V.UA Domain Administrator : https://domain.v.ua/
// Submitted by Serhii Rostilo <sergey@rostilo.kiev.ua>
v.ua

// Waffle Computer Inc., Ltd. : https://docs.waffleinfo.com
// Submitted by Masayuki Note <masa@blade.wafflecell.com>
wafflecell.com

// WapBlog.ID : https://www.wapblog.id
// Submitted by Fajar Sodik <official@wapblog.id>
idnblogger.com
indowapblog.com
bloger.id
wblog.id
wbq.me
fastblog.net

// WebHare bv: https://www.webhare.com/
// Submitted by Arnold Hendriks <info@webhare.com>
*.webhare.dev

// WebHotelier Technologies Ltd: https://www.webhotelier.net/
// Submitted by Apostolos Tsakpinis <apostolos.tsakpinis@gmail.com>
reserve-online.net
reserve-online.com
bookonline.app
hotelwithflight.com

// WeDeploy by Liferay, Inc. : https://www.wedeploy.com
// Submitted by Henrique Vicente <security@wedeploy.com>
wedeploy.io
wedeploy.me
wedeploy.sh

// Western Digital Technologies, Inc : https://www.wdc.com
// Submitted by Jung Jin <jungseok.jin@wdc.com>
remotewd.com

// WIARD Enterprises : https://wiardweb.com
// Submitted by Kidd Hustle <kiddhustle@wiardweb.com>
pages.wiardweb.com

// Wikimedia Labs : https://wikitech.wikimedia.org
// Submitted by Arturo Borrero Gonzalez <aborrero@wikimedia.org>
wmflabs.org
toolforge.org
wmcloud.org

// WISP : https://wisp.gg
// Submitted by Stepan Fedotov <stepan@wisp.gg>
panel.gg
daemon.panel.gg

// WoltLab GmbH : https://www.woltlab.com
// Submitted by Tim Düsterhus <security@woltlab.cloud>
woltlab-demo.com
myforum.community
community-pro.de
diskussionsbereich.de
community-pro.net
meinforum.net

// WP Engine : https://wpengine.com/
// Submitted by Michael Smith <michael.smith@wpengine.com>
// Submitted by Brandon DuRette <brandon.durette@wpengine.com>
wpenginepowered.com
js.wpenginepowered.com

// Wix.com, Inc. : https://www.wix.com
// Submitted by Shahar Talmi <shahart@wix.com>
wixsite.com
editorx.io

// XenonCloud GbR: https://xenoncloud.net
// Submitted by Julian Uphoff <publicsuffixlist@xenoncloud.net>
half.host

// XnBay Technology : http://www.xnbay.com/
// Submitted by XnBay Developer <developer.xncloud@gmail.com>
xnbay.com
u2.xnbay.com
u2-local.xnbay.com

// XS4ALL Internet bv : https://www.xs4all.nl/
// Submitted by Daniel Mostertman <unixbeheer+publicsuffix@xs4all.net>
cistron.nl
demon.nl
xs4all.space

// Yandex.Cloud LLC: https://cloud.yandex.com
// Submitted by Alexander Lodin <security+psl@yandex-team.ru>
yandexcloud.net
storage.yandexcloud.net
website.yandexcloud.net

// YesCourse Pty Ltd : https://yescourse.com
// Submitted by Atul Bhouraskar <atul@yescourse.com>
official.academy

// Yola : https://www.yola.com/
// Submitted by Stefano Rivera <stefano@yola.com>
yolasite.com

// Yombo : https://yombo.net
// Submitted by Mitch Schwenk <mitch@yombo.net>
ybo.faith
yombo.me
homelink.one
ybo.party
ybo.review
ybo.science
ybo.trade

// Yunohost : https://yunohost.org
// Submitted by Valentin Grimaud <security@yunohost.org>
ynh.fr
nohost.me
noho.st

// ZaNiC : http://www.za.net/
// Submitted by registry <hostmaster@nic.za.net>
za.net
za.org

// Zine EOOD : https://zine.bg/
// Submitted by Martin Angelov <martin@zine.bg>
bss.design

// Zitcom A/S : https://www.zitcom.dk
// Submitted by Emil Stahl <esp@zitcom.dk>
basicserver.io
virtualserver.io
enterprisecloud.nu

// ===END PRIVATE DOMAINS===
END_BUILTIN_DATA
1;
                                                                                                                                                                                             Socket/SSL/Utils.pm                                                                                 0000644                 00000054321 00000000000 0010041 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       
package IO::Socket::SSL::Utils;
use strict;
use warnings;
use Carp 'croak';
use Net::SSLeay;

# old versions of Exporter do not export 'import' yet
require Exporter;
*import = \&Exporter::import;

our $VERSION = '2.015';
our @EXPORT = qw(
    PEM_file2cert PEM_file2certs PEM_string2cert PEM_cert2file PEM_certs2file PEM_cert2string
    PEM_file2key PEM_string2key PEM_key2file PEM_key2string
    KEY_free CERT_free
    KEY_create_rsa CERT_asHash CERT_create
);

sub PEM_file2cert {
    my $file = shift;
    my $bio = Net::SSLeay::BIO_new_file($file,'r') or
	croak "cannot read $file: $!";
    my $cert = Net::SSLeay::PEM_read_bio_X509($bio);
    Net::SSLeay::BIO_free($bio);
    $cert or croak "cannot parse $file as PEM X509 cert: ".
	Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error());
    return $cert;
}

sub PEM_cert2file {
    my ($cert,$file) = @_;
    my $string = Net::SSLeay::PEM_get_string_X509($cert)
	or croak("cannot get string from cert");
    open( my $fh,'>',$file ) or croak("cannot write $file: $!");
    print $fh $string;
}

use constant PEM_R_NO_START_LINE => 108;
sub PEM_file2certs {
    my $file = shift;
    my $bio = Net::SSLeay::BIO_new_file($file,'r') or
	croak "cannot read $file: $!";
    my @certs;
    while (1) {
	if (my $cert = Net::SSLeay::PEM_read_bio_X509($bio)) {
	    push @certs, $cert;
	} else {
	    Net::SSLeay::BIO_free($bio);
	    my $error = Net::SSLeay::ERR_get_error();
	    last if ($error & 0xfff) == PEM_R_NO_START_LINE && @certs;
	    croak "cannot parse $file as PEM X509 cert: " .
		Net::SSLeay::ERR_error_string($error);
	}
    }
    return @certs;
}

sub PEM_certs2file {
    my $file = shift;
    open( my $fh,'>',$file ) or croak("cannot write $file: $!");
    for my $cert (@_) {
	my $string = Net::SSLeay::PEM_get_string_X509($cert)
	    or croak("cannot get string from cert");
	print $fh $string;
    }
}


sub PEM_string2cert {
    my $string = shift;
    my $bio = Net::SSLeay::BIO_new( Net::SSLeay::BIO_s_mem());
    Net::SSLeay::BIO_write($bio,$string);
    my $cert = Net::SSLeay::PEM_read_bio_X509($bio);
    Net::SSLeay::BIO_free($bio);
    $cert or croak "cannot parse string as PEM X509 cert: ".
	Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error());
    return $cert;
}

sub PEM_cert2string {
    my $cert = shift;
    return Net::SSLeay::PEM_get_string_X509($cert)
	|| croak("cannot get string from cert");
}

sub PEM_file2key {
    my $file = shift;
    my $bio = Net::SSLeay::BIO_new_file($file,'r') or
	croak "cannot read $file: $!";
    my $key = Net::SSLeay::PEM_read_bio_PrivateKey($bio);
    Net::SSLeay::BIO_free($bio);
    $key or croak "cannot parse $file as PEM private key: ".
	Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error());
    return $key;
}

sub PEM_key2file {
    my ($key,$file) = @_;
    my $string = Net::SSLeay::PEM_get_string_PrivateKey($key)
	or croak("cannot get string from key");
    open( my $fh,'>',$file ) or croak("cannot write $file: $!");
    print $fh $string;
}

sub PEM_string2key {
    my $string = shift;
    my $bio = Net::SSLeay::BIO_new( Net::SSLeay::BIO_s_mem());
    Net::SSLeay::BIO_write($bio,$string);
    my $key = Net::SSLeay::PEM_read_bio_PrivateKey($bio);
    Net::SSLeay::BIO_free($bio);
    $key or croak "cannot parse string as PEM private key: ".
	Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error());
    return $key;
}

sub PEM_key2string {
    my $key = shift;
    return Net::SSLeay::PEM_get_string_PrivateKey($key)
	|| croak("cannot get string from key");
}

sub CERT_free {
    Net::SSLeay::X509_free($_) for @_;
}

sub KEY_free {
    Net::SSLeay::EVP_PKEY_free($_) for @_;
}

sub KEY_create_rsa {
    my $bits = shift || 2048;
    my $key = Net::SSLeay::EVP_PKEY_new();
    my $rsa = Net::SSLeay::RSA_generate_key($bits, 0x10001); # 0x10001 = RSA_F4
    Net::SSLeay::EVP_PKEY_assign_RSA($key,$rsa);
    return $key;
}

if (defined &Net::SSLeay::EC_KEY_generate_key) {
    push @EXPORT,'KEY_create_ec';
    *KEY_create_ec = sub {
	my $curve = shift || 'prime256v1';
	my $key = Net::SSLeay::EVP_PKEY_new();
	my $ec = Net::SSLeay::EC_KEY_generate_key($curve);
	Net::SSLeay::EVP_PKEY_assign_EC_KEY($key,$ec);
	return $key;
    }
}

# extract information from cert
my %gen2i = qw( OTHERNAME 0 EMAIL 1 DNS 2 X400 3 DIRNAME 4 EDIPARTY 5 URI 6 IP 7 RID 8 );
my %i2gen = reverse %gen2i;
sub CERT_asHash {
    my $cert = shift;
    my $digest_name = shift || 'sha256';

    my %hash = (
	version => Net::SSLeay::X509_get_version($cert),
	not_before => _asn1t2t(Net::SSLeay::X509_get_notBefore($cert)),
	not_after => _asn1t2t(Net::SSLeay::X509_get_notAfter($cert)),
	serial => Net::SSLeay::P_ASN1_INTEGER_get_dec(
	    Net::SSLeay::X509_get_serialNumber($cert)),
	signature_alg => Net::SSLeay::OBJ_obj2txt (
	    Net::SSLeay::P_X509_get_signature_alg($cert)),
	crl_uri  => [ Net::SSLeay::P_X509_get_crl_distribution_points($cert) ],
	keyusage => [ Net::SSLeay::P_X509_get_key_usage($cert) ],
	extkeyusage => {
	    oid => [ Net::SSLeay::P_X509_get_ext_key_usage($cert,0) ],
	    nid => [ Net::SSLeay::P_X509_get_ext_key_usage($cert,1) ],
	    sn  => [ Net::SSLeay::P_X509_get_ext_key_usage($cert,2) ],
	    ln  => [ Net::SSLeay::P_X509_get_ext_key_usage($cert,3) ],
	},
	"pubkey_digest_$digest_name" => Net::SSLeay::X509_pubkey_digest(
	    $cert,_digest($digest_name)),
	"x509_digest_$digest_name" => Net::SSLeay::X509_digest(
	    $cert,_digest($digest_name)),
	"fingerprint_$digest_name" => Net::SSLeay::X509_get_fingerprint(
	    $cert,$digest_name),
    );

    for([ subject => Net::SSLeay::X509_get_subject_name($cert) ],
	[ issuer => Net::SSLeay::X509_get_issuer_name($cert) ]) {
	my ($what,$subj) = @$_;
	my %subj;
	for ( 0..Net::SSLeay::X509_NAME_entry_count($subj)-1 ) {
	    my $e = Net::SSLeay::X509_NAME_get_entry($subj,$_);
	    my $k = Net::SSLeay::OBJ_obj2txt(
		Net::SSLeay::X509_NAME_ENTRY_get_object($e));
	    my $v = Net::SSLeay::P_ASN1_STRING_get(
		    Net::SSLeay::X509_NAME_ENTRY_get_data($e));
	    if (!exists $subj{$k}) {
		$subj{$k} = $v;
	    } elsif (!ref $subj{$k}) {
		$subj{$k} = [ $subj{$k}, $v ];
	    } else {
		push @{$subj{$k}}, $v;
	    }
	}
	$hash{$what} = \%subj;
    }


    if ( my @names = Net::SSLeay::X509_get_subjectAltNames($cert) ) {
	my $alt = $hash{subjectAltNames} = [];
	while (my ($t,$v) = splice(@names,0,2)) {
	    $t = $i2gen{$t} || die "unknown type $t in subjectAltName";
	    if ( $t eq 'IP' ) {
		if (length($v) == 4) {
		    $v = join('.',unpack("CCCC",$v));
		} elsif ( length($v) == 16 ) {
		    my @v = unpack("nnnnnnnn",$v);
		    my ($best0,$last0);
		    for(my $i=0;$i<@v;$i++) {
			if ($v[$i] == 0) {
			    if ($last0) {
				$last0->[1] = $i;
				$last0->[2]++;
				$best0 = $last0 if ++$last0->[2]>$best0->[2];
			    } else {
				$last0 = [ $i,$i,0 ];
				$best0 ||= $last0;
			    }
			} else {
			    $last0 = undef;
			}
		    }
		    if ($best0) {
			$v = '';
			$v .= join(':', map { sprintf( "%x",$_) } @v[0..$best0->[0]-1]) if $best0->[0]>0;
			$v .= '::';
			$v .= join(':', map { sprintf( "%x",$_) } @v[$best0->[1]+1..$#v]) if $best0->[1]<$#v;
		    } else {
			$v = join(':', map { sprintf( "%x",$_) } @v);
		    }
		}
	    }
	    push @$alt,[$t,$v]
	}
    }

    my @ext;
    for( 0..Net::SSLeay::X509_get_ext_count($cert)-1 ) {
	my $e = Net::SSLeay::X509_get_ext($cert,$_);
	my $o = Net::SSLeay::X509_EXTENSION_get_object($e);
	my $nid = Net::SSLeay::OBJ_obj2nid($o);
	push @ext, {
	    oid => Net::SSLeay::OBJ_obj2txt($o),
	    nid => ( $nid > 0 ) ? $nid : undef,
	    sn  => ( $nid > 0 ) ? Net::SSLeay::OBJ_nid2sn($nid) : undef,
	    critical => Net::SSLeay::X509_EXTENSION_get_critical($e),
	    data => Net::SSLeay::X509V3_EXT_print($e),
	}
    }
    $hash{ext} = \@ext;

    if ( defined(&Net::SSLeay::P_X509_get_ocsp_uri)) {
	$hash{ocsp_uri} = [ Net::SSLeay::P_X509_get_ocsp_uri($cert) ];
    } else {
	$hash{ocsp_uri} = [];
	for( @ext ) {
	    $_->{sn} or next;
	    $_->{sn} eq 'authorityInfoAccess' or next;
	    push @{ $hash{ocsp_uri}}, $_->{data} =~m{\bOCSP - URI:(\S+)}g;
	}
    }

    return \%hash;
}

sub CERT_create {
    my %args = @_%2 ? %{ shift() } :  @_;

    my $cert = Net::SSLeay::X509_new();
    my $digest_name = delete $args{digest} || 'sha256';

    Net::SSLeay::ASN1_INTEGER_set(
	Net::SSLeay::X509_get_serialNumber($cert),
	delete $args{serial} || rand(2**32),
    );

    # version default to 2 (V3)
    Net::SSLeay::X509_set_version($cert,
	delete $args{version} || 2 );

    # not_before default to now
    Net::SSLeay::ASN1_TIME_set(
	Net::SSLeay::X509_get_notBefore($cert),
	delete $args{not_before} || time()
    );

    # not_after default to now+365 days
    Net::SSLeay::ASN1_TIME_set(
	Net::SSLeay::X509_get_notAfter($cert),
	delete $args{not_after} || time() + 365*86400
    );

    # set subject
    my $subj_e = Net::SSLeay::X509_get_subject_name($cert);
    my $subj = delete $args{subject} || {
	organizationName => 'IO::Socket::SSL',
	commonName => 'IO::Socket::SSL Test'
    };

    while ( my ($k,$v) = each %$subj ) {
	# Not everything we get is nice - try with MBSTRING_UTF8 first and if it
	# fails try V_ASN1_T61STRING and finally V_ASN1_OCTET_STRING
	for (ref($v) ? @$v : ($v)) {
	    Net::SSLeay::X509_NAME_add_entry_by_txt($subj_e,$k,0x1000,$_,-1,0)
		or Net::SSLeay::X509_NAME_add_entry_by_txt($subj_e,$k,20,$_,-1,0)
		or Net::SSLeay::X509_NAME_add_entry_by_txt($subj_e,$k,4,$_,-1,0)
		or croak("failed to add entry for $k - ".
		Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error()));
	}
    }

    my @ext = (
	&Net::SSLeay::NID_subject_key_identifier => 'hash',
	&Net::SSLeay::NID_authority_key_identifier => 'keyid',
    );
    if ( my $altsubj = delete $args{subjectAltNames} ) {
	push @ext,
	    &Net::SSLeay::NID_subject_alt_name =>
	    join(',', map { "$_->[0]:$_->[1]" } @$altsubj)
    }

    my $key = delete $args{key} || KEY_create_rsa();
    Net::SSLeay::X509_set_pubkey($cert,$key);

    my $is = delete $args{issuer};
    my $issuer_cert = delete $args{issuer_cert} || $is && $is->[0] || $cert;
    my $issuer_key  = delete $args{issuer_key}  || $is && $is->[1] || $key;

    my %purpose;
    if (my $p = delete $args{purpose}) {
	if (!ref($p)) {
	    $purpose{lc($2)} = (!$1 || $1 eq '+') ? 1:0
		while $p =~m{([+-]?)(\w+)}g;
	} elsif (ref($p) eq 'ARRAY') {
	    for(@$p) {
		m{^([+-]?)(\w+)$} or die "invalid entry in purpose: $_";
		$purpose{lc($2)} = (!$1 || $1 eq '+') ? 1:0
	    }
	} else {
	    while( my ($k,$v) = each %$p) {
		$purpose{lc($k)} = ($v && $v ne '-')?1:0;
	    }
	}
    }
    if (delete $args{CA}) {
	# add defaults for CA
	%purpose = (
	    ca => 1, sslca => 1, emailca => 1, objca => 1,
	    %purpose
	);
    }
    if (!%purpose) {
	%purpose = (server => 1, client => 1);
    }

    my (%key_usage,%ext_key_usage,%cert_type,%basic_constraints);

    my %dS = ( digitalSignature => \%key_usage );
    my %kE = ( keyEncipherment => \%key_usage );
    my %CA = ( 'CA:TRUE' => \%basic_constraints, %dS, keyCertSign => \%key_usage );
    my @disable;
    for(
	[ client  => { %dS, %kE, clientAuth => \%ext_key_usage, client  => \%cert_type } ],
	[ server  => { %dS, %kE, serverAuth => \%ext_key_usage, server  => \%cert_type } ],
	[ email   => { %dS, %kE, emailProtection => \%ext_key_usage, email => \%cert_type } ],
	[ objsign => { %dS, %kE, codeSigning => \%ext_key_usage, objsign => \%cert_type } ],

	[ CA      => { %CA }],
	[ sslCA   => { %CA, sslCA => \%cert_type }],
	[ emailCA => { %CA, emailCA => \%cert_type }],
	[ objCA   => { %CA, objCA => \%cert_type }],

	[ emailProtection  => { %dS, %kE, emailProtection => \%ext_key_usage, email => \%cert_type } ],
	[ codeSigning      => { %dS, %kE, codeSigning => \%ext_key_usage, objsign => \%cert_type } ],

	[ timeStamping     => { timeStamping => \%ext_key_usage } ],
	[ digitalSignature => { digitalSignature => \%key_usage } ],
	[ nonRepudiation   => { nonRepudiation => \%key_usage } ],
	[ keyEncipherment  => { keyEncipherment => \%key_usage } ],
	[ dataEncipherment => { dataEncipherment => \%key_usage } ],
	[ keyAgreement     => { keyAgreement => \%key_usage } ],
	[ keyCertSign      => { keyCertSign => \%key_usage } ],
	[ cRLSign          => { cRLSign => \%key_usage } ],
	[ encipherOnly     => { encipherOnly => \%key_usage } ],
	[ decipherOnly     => { decipherOnly => \%key_usage } ],
	[ clientAuth       => { clientAuth   => \%ext_key_usage } ],
	[ serverAuth       => { serverAuth   => \%ext_key_usage } ],
    ) {
	exists $purpose{lc($_->[0])} or next;
	if (delete $purpose{lc($_->[0])}) {
	    while (my($k,$h) = each %{$_->[1]}) {
		$h->{$k} = 1;
	    }
	} else {
	    push @disable, $_->[1];
	}
    }
    die "unknown purpose ".join(",",keys %purpose) if %purpose;
    for(@disable) {
	while (my($k,$h) = each %$_) {
	    delete $h->{$k};
	}
    }

    if (%basic_constraints) {
	push @ext,&Net::SSLeay::NID_basic_constraints,
	    => join(",",'critical', sort keys %basic_constraints);
    } else {
	push @ext, &Net::SSLeay::NID_basic_constraints => 'critical,CA:FALSE';
    }
    push @ext,&Net::SSLeay::NID_key_usage
	=> join(",",'critical', sort keys %key_usage) if %key_usage;
    push @ext,&Net::SSLeay::NID_netscape_cert_type
	=> join(",",sort keys %cert_type) if %cert_type;
    push @ext,&Net::SSLeay::NID_ext_key_usage
	=> join(",",sort keys %ext_key_usage) if %ext_key_usage;
    Net::SSLeay::P_X509_add_extensions($cert, $issuer_cert, @ext);

    my %have_ext;
    for(my $i=0;$i<@ext;$i+=2) {
	$have_ext{ $ext[$i] }++
    }
    for my $ext (@{ $args{ext} || [] }) {
	my $nid = $ext->{nid}
	    || $ext->{sn} && Net::SSLeay::OBJ_sn2nid($ext->{sn})
	    || croak "cannot determine NID of extension";
	$have_ext{$nid} and next;
	my $val = $ext->{data};
	if ($nid == 177) {
	    # authorityInfoAccess:
	    # OpenSSL i2v does not output the same way as expected by i2v :(
	    for (split(/\n/,$val)) {
		s{ - }{;}; # "OCSP - URI:..." -> "OCSP;URI:..."
		$_ = "critical,$_" if $ext->{critical};
		Net::SSLeay::P_X509_add_extensions($cert,$issuer_cert,$nid,$_);
	    }
	} else {
	    $val = "critical,$val" if $ext->{critical};
	    Net::SSLeay::P_X509_add_extensions($cert, $issuer_cert, $nid, $val);
	}
    }

    Net::SSLeay::X509_set_issuer_name($cert,
	Net::SSLeay::X509_get_subject_name($issuer_cert));
    Net::SSLeay::X509_sign($cert,$issuer_key,_digest($digest_name));

    return ($cert,$key);
}



if ( defined &Net::SSLeay::ASN1_TIME_timet ) {
    *_asn1t2t = \&Net::SSLeay::ASN1_TIME_timet
} else {
    require Time::Local;
    my %mon2i = qw(
	Jan 0 Feb 1 Mar 2 Apr 3 May 4 Jun 5
	Jul 6 Aug 7 Sep 8 Oct 9 Nov 10 Dec 11
    );
    *_asn1t2t = sub {
	my $t = Net::SSLeay::P_ASN1_TIME_put2string( shift );
	my ($mon,$d,$h,$m,$s,$y,$tz) = split(/[\s:]+/,$t);
	defined( $mon = $mon2i{$mon} ) or die "invalid month in $t";
	$tz ||= $y =~s{^(\d+)([A-Z]\S*)}{$1} && $2;
	if ( ! $tz ) {
	    return Time::Local::timelocal($s,$m,$h,$d,$mon,$y)
	} elsif ( $tz eq 'GMT' ) {
	    return Time::Local::timegm($s,$m,$h,$d,$mon,$y)
	} else {
	    die "unexpected TZ $tz from ASN1_TIME_print";
	}
    }
}

{
    my %digest;
    sub _digest {
	my $digest_name = shift;
	return $digest{$digest_name} ||= do {
	    Net::SSLeay::SSLeay_add_ssl_algorithms();
	    Net::SSLeay::EVP_get_digestbyname($digest_name)
		or die "Digest algorithm $digest_name is not available";
	};
    }
}


1;

__END__

=head1 NAME

IO::Socket::SSL::Utils -- loading, storing, creating certificates and keys

=head1 SYNOPSIS

    use IO::Socket::SSL::Utils;

    $cert = PEM_file2cert('cert.pem');     # load certificate from file
    my $hash = CERT_asHash($cert);         # get details from certificate
    PEM_cert2file('cert.pem',$cert);       # write certificate to file
    CERT_free($cert);                      # free memory within OpenSSL

    @certs = PEM_file2certs('chain.pem');  # load multiple certificates from file
    PEM_certs2file('chain.pem', @certs);   # write multiple certificates to file
    CERT_free(@certs);                     # free memory for all within OpenSSL

    my $cert = PEM_string2cert($pem);      # load certificate from PEM string
    $pem = PEM_cert2string($cert);         # convert certificate to PEM string

    $key = KEY_create_rsa(2048);           # create new 2048-bit RSA key
    PEM_string2file($key,"key.pem");       # and write it to file
    KEY_free($key);                        # free memory within OpenSSL


=head1 DESCRIPTION

This module provides various utility functions to work with certificates and
private keys, shielding some of the complexity of the underlying Net::SSLeay and
OpenSSL.

=head1 FUNCTIONS

=over 4

=item *

Functions converting between string or file and certificates and keys.
They croak if the operation cannot be completed.

=over 8

=item PEM_file2cert(file) -> cert

=item PEM_cert2file(cert,file)

=item PEM_file2certs(file) -> @certs

=item PEM_certs2file(file,@certs)

=item PEM_string2cert(string) -> cert

=item PEM_cert2string(cert) -> string

=item PEM_file2key(file) -> key

=item PEM_key2file(key,file)

=item PEM_string2key(string) -> key

=item PEM_key2string(key) -> string

=back

=item *

Functions for cleaning up.
Each loaded or created cert and key must be freed to not leak memory.

=over 8

=item CERT_free(@certs)

=item KEY_free(@keys)

=back

=item * KEY_create_rsa(bits) -> key

Creates an RSA key pair, bits defaults to 2048.

=item * KEY_create_ec(curve) -> key

Creates an EC key, curve defaults to C<prime256v1>.

=item * CERT_asHash(cert,[digest_algo]) -> hash

Extracts the information from the certificate into a hash and uses the given
digest_algo (default: SHA-256) to determine digest of pubkey and cert.
The resulting hash contains:

=over 8

=item subject

Hash with the parts of the subject, e.g. commonName, countryName,
organizationName, stateOrProvinceName, localityName. If there are multiple
values for any of these parts the hash value will be an array ref with the
values in order instead of just a scalar.

=item subjectAltNames

Array with list of alternative names. Each entry in the list is of
C<[type,value]>, where C<type> can be OTHERNAME, EMAIL, DNS, X400, DIRNAME,
EDIPARTY, URI, IP or RID.

=item issuer

Hash with the parts of the issuer, e.g. commonName, countryName,
organizationName, stateOrProvinceName, localityName. If there are multiple
values for any of these parts the hash value will be an array ref with the
values in order instead of just a scalar.

=item not_before, not_after

The time frame, where the certificate is valid, as time_t, e.g. can be converted
with localtime or similar functions.

=item serial

The serial number

=item crl_uri

List of URIs for CRL distribution.

=item ocsp_uri

List of URIs for revocation checking using OCSP.

=item keyusage

List of keyUsage information in the certificate.

=item extkeyusage

List of extended key usage information from the certificate. Each entry in
this list consists of a hash with oid, nid, ln and sn.

=item pubkey_digest_xxx

Binary digest of the pubkey using the given digest algorithm, e.g.
pubkey_digest_sha256 if (the default) SHA-256 was used.

=item x509_digest_xxx

Binary digest of the X.509 certificate using the given digest algorithm, e.g.
x509_digest_sha256 if (the default) SHA-256 was used.

=item fingerprint_xxx

Fingerprint of the certificate using the given digest algorithm, e.g.
fingerprint_sha256 if (the default) SHA-256 was used. Contrary to digest_* this
is an ASCII string with a list if hexadecimal numbers, e.g.
"73:59:75:5C:6D...".

=item signature_alg

Algorithm used to sign certificate, e.g. C<sha256WithRSAEncryption>.

=item ext

List of extensions.
Each entry in the list is a hash with oid, nid, sn, critical flag (boolean) and
data (string representation given by X509V3_EXT_print).

=item version

Certificate version, usually 2 (x509v3)

=back

=item * CERT_create(hash) -> (cert,key)

Creates a certificate based on the given hash.
If the issuer is not specified the certificate will be self-signed.
The following keys can be given:

=over 8

=item subject

Hash with the parts of the subject, e.g. commonName, countryName, ... as
described in C<CERT_asHash>.
Default points to IO::Socket::SSL.

=item not_before

A time_t value when the certificate starts to be valid. Defaults to current
time.

=item not_after

A time_t value when the certificate ends to be valid. Defaults to current
time plus one 365 days.

=item serial

The serial number. If not given a random number will be used.

=item version

The version of the certificate, default 2 (x509v3).

=item CA true|false

If true declare certificate as CA, defaults to false.

=item purpose string|array|hash

Set the purpose of the certificate.
The different purposes can be given as a string separated by non-word character,
as array or hash. With string or array each purpose can be prefixed with '+'
(enable) or '-' (disable) and same can be done with the value when given as a
hash. By default enabling the purpose is assumed.

If the CA option is given and true the defaults "ca,sslca,emailca,objca" are
assumed, but can be overridden with explicit purpose.
If the CA option is given and false the defaults "server,client" are assumed.
If no CA option and no purpose is given it defaults to "server,client".

Purpose affects basicConstraints, keyUsage, extKeyUsage and netscapeCertType.
The following purposes are defined (case is not important):

    client
    server
    email
    objsign

    CA
    sslCA
    emailCA
    objCA

    emailProtection
    codeSigning
    timeStamping

    digitalSignature
    nonRepudiation
    keyEncipherment
    dataEncipherment
    keyAgreement
    keyCertSign
    cRLSign
    encipherOnly
    decipherOnly

Examples:

     # root-CA for SSL certificates
     purpose => 'sslCA'   # or CA => 1

     # server certificate and CA (typically self-signed)
     purpose => 'sslCA,server'

     # client certificate
     purpose => 'client',


=item ext [{ sn => .., data => ... }, ... ]

List of extensions. The type of the extension can be specified as name with
C<sn> or as NID with C<nid> and the data with C<data>. These data must be in the
same syntax as expected within openssl.cnf, e.g. something like
C<OCSP;URI=http://...>. Additionally the critical flag can be set with
C<critical => 1>.

=item key key

use given key as key for certificate, otherwise a new one will be generated and
returned

=item issuer_cert cert

set issuer for new certificate

=item issuer_key key

sign new certificate with given key

=item issuer [ cert, key ]

Instead of giving issuer_key and issuer_cert as separate arguments they can be
given both together.

=item digest algorithm

specify the algorithm used to sign the certificate, default SHA-256.

=back

=back

=head1 AUTHOR

Steffen Ullrich
                                                                                                                                                                                                                                                                                                               Socket/SSL/Intercept.pm                                                                             0000644                 00000026163 00000000000 0010701 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       
package IO::Socket::SSL::Intercept;
use strict;
use warnings;
use Carp 'croak';
use IO::Socket::SSL::Utils;
use Net::SSLeay;

our $VERSION = '2.056';


sub new {
    my ($class,%args) = @_;

    my $cacert = delete $args{proxy_cert};
    if ( ! $cacert ) {
	if ( my $f = delete $args{proxy_cert_file} ) {
	    $cacert = PEM_file2cert($f);
	} else {
	    croak "no proxy_cert or proxy_cert_file given";
	}
    }

    my $cakey  = delete $args{proxy_key};
    if ( ! $cakey ) {
	if ( my $f = delete $args{proxy_key_file} ) {
	    $cakey = PEM_file2key($f);
	} else {
	    croak "no proxy_cert or proxy_cert_file given";
	}
    }

    my $certkey = delete $args{cert_key};
    if ( ! $certkey ) {
	if ( my $f = delete $args{cert_key_file} ) {
	    $certkey = PEM_file2key($f);
	}
    }

    my $cache = delete $args{cache} || {};
    if (ref($cache) eq 'CODE') {
	# check cache type
	my $type = $cache->('type');
	if (!$type) {
	    # old cache interface - change into new interface
	    # get: $cache->(fp)
	    # set: $cache->(fp,cert,key)
	    my $oc = $cache;
	    $cache = sub {
		my ($fp,$create_cb) = @_;
		my @ck = $oc->($fp);
		$oc->($fp, @ck = &$create_cb) if !@ck;
		return @ck;
	    };
	} elsif ($type == 1) {
	    # current interface:
	    # get/set: $cache->(fp,cb_create)
	} else {
	    die "invalid type of cache: $type";
	}
    }

    my $self = bless {
	cacert => $cacert,
	cakey => $cakey,
	certkey => $certkey,
	cache => $cache,
	serial => delete $args{serial},
    };
    return $self;
}

sub DESTROY {
    # call various ssl _free routines
    my $self = shift or return;
    for ( \$self->{cacert}, 
	map { \$_->{cert} } ref($self->{cache}) ne 'CODE' ? values %{$self->{cache}} :()) {
	$$_ or next;
	CERT_free($$_);
	$$_ = undef;
    }
    for ( \$self->{cakey}, \$self->{pubkey} ) {
	$$_ or next;
	KEY_free($$_);
	$$_ = undef;
    }
}

sub clone_cert {
    my ($self,$old_cert,$clone_key) = @_;

    my $hash = CERT_asHash($old_cert);
    my $create_cb = sub {
	# if not in cache create new certificate based on original
	# copy most but not all extensions
	if (my $ext = $hash->{ext}) {
	    @$ext = grep {
		defined($_->{sn}) && $_->{sn} !~m{^(?:
		    authorityInfoAccess    |
		    subjectKeyIdentifier   |
		    authorityKeyIdentifier |
		    certificatePolicies    |
		    crlDistributionPoints
		)$}x
	    } @$ext;
	}
	my ($clone,$key) = CERT_create(
	    %$hash,
	    issuer_cert => $self->{cacert},
	    issuer_key => $self->{cakey},
	    key => $self->{certkey},
	    serial =>
		! defined($self->{serial}) ? (unpack('L',$hash->{x509_digest_sha256}))[0] :
		ref($self->{serial}) eq 'CODE' ? $self->{serial}($old_cert,$hash) :
		++$self->{serial},
	);
	return ($clone,$key);
    };

    $clone_key ||= substr(unpack("H*", $hash->{x509_digest_sha256}),0,32);
    my $c = $self->{cache};
    return $c->($clone_key,$create_cb) if ref($c) eq 'CODE';

    my $e = $c->{$clone_key} ||= do {
	my ($cert,$key) = &$create_cb;
	{ cert => $cert, key => $key };
    };
    $e->{atime} = time();
    return ($e->{cert},$e->{key});
}


sub STORABLE_freeze { my $self = shift; $self->serialize() }
sub STORABLE_thaw   { my ($class,undef,$data) = @_; $class->unserialize($data) }

sub serialize {
    my $self = shift;
    my $data = pack("N",2); # version
    $data .= pack("N/a", PEM_cert2string($self->{cacert}));
    $data .= pack("N/a", PEM_key2string($self->{cakey}));
    if ( $self->{certkey} ) {
	$data .= pack("N/a", PEM_key2string($self->{certkey}));
    } else {
	$data .= pack("N/a", '');
    }
    $data .= pack("N",$self->{serial});
    if ( ref($self->{cache}) eq 'HASH' ) {
	while ( my($k,$v) = each %{ $self->{cache}} ) {
	    $data .= pack("N/aN/aN/aN", $k,
		PEM_cert2string($k->{cert}),
		$k->{key} ? PEM_key2string($k->{key}) : '',
		$k->{atime});
	}
    }
    return $data;
}

sub unserialize {
    my ($class,$data) = @_;
    unpack("N",substr($data,0,4,'')) == 2 or 
	croak("serialized with wrong version");
    ( my $cacert,my $cakey,my $certkey,my $serial,$data) 
	= unpack("N/aN/aN/aNa*",$data);
    my $self = bless {
	serial => $serial,
	cacert => PEM_string2cert($cacert),
	cakey => PEM_string2key($cakey),
	$certkey ? ( certkey => PEM_string2key($certkey)):(),
    }, ref($class)||$class;

    $self->{cache} = {} if $data ne '';
    while ( $data ne '' ) {
	(my $key,my $cert,my $certkey, my $atime,$data) = unpack("N/aN/aNa*",$data);
	$self->{cache}{$key} = { 
	    cert => PEM_string2cert($cert), 
	    $key ? ( key => PEM_string2key($certkey)):(),
	    atime => $atime 
	};
    }
    return $self;
}

1;

__END__

=head1 NAME

IO::Socket::SSL::Intercept -- SSL interception (man in the middle)

=head1 SYNOPSIS

    use IO::Socket::SSL::Intercept;
    # create interceptor with proxy certificates
    my $mitm = IO::Socket::SSL::Intercept->new(
	proxy_cert_file => 'proxy_cert.pem',
	proxy_key_file  => 'proxy_key.pem',
	...
    );
    my $listen = IO::Socket::INET->new( LocalAddr => .., Listen => .. );
    while (1) {
	# TCP accept new client
	my $client = $listen->accept or next;
	# SSL connect to server
	my $server = IO::Socket::SSL->new(
	    PeerAddr => ..,
	    SSL_verify_mode => ...,
	    ...
	) or die "ssl connect failed: $!,$SSL_ERROR";
	# clone server certificate
	my ($cert,$key) = $mitm->clone_cert( $server->peer_certificate );
	# and upgrade client side to SSL with cloned certificate
	IO::Socket::SSL->start_SSL($client,
	    SSL_server => 1,
	    SSL_cert => $cert,
	    SSL_key => $key
	) or die "upgrade failed: $SSL_ERROR";
	# now transfer data between $client and $server and analyze
	# the unencrypted data
	...
    }


=head1 DESCRIPTION

This module provides functionality to clone certificates and sign them with a
proxy certificate, thus making it easy to intercept SSL connections (man in the
middle). It also manages a cache of the generated certificates.

=head1 How Intercepting SSL Works

Intercepting SSL connections is useful for analyzing encrypted traffic for
security reasons or for testing. It does not break the end-to-end security of
SSL, e.g. a properly written client will notice the interception unless you
explicitly configure the client to trust your interceptor.
Intercepting SSL works the following way:

=over 4

=item *

Create a new CA certificate, which will be used to sign the cloned certificates.
This proxy CA certificate should be trusted by the client, or (a properly
written client) will throw error messages or deny the connections because it
detected a man in the middle attack.
Due to the way the interception works there no support for client side
certificates is possible.

Using openssl such a proxy CA certificate and private key can be created with:

  openssl genrsa -out proxy_key.pem 1024
  openssl req -new -x509 -extensions v3_ca -key proxy_key.pem -out proxy_cert.pem
  # export as PKCS12 for import into browser
  openssl pkcs12 -export -in proxy_cert.pem -inkey proxy_key.pem -out proxy_cert.p12

=item * 

Configure client to connect to use intercepting proxy or somehow redirect
connections from client to the proxy (e.g. packet filter redirects, ARP or DNS
spoofing etc).

=item *

Accept the TCP connection from the client, e.g. don't do any SSL handshakes with
the client yet.

=item *

Establish the SSL connection to the server and verify the servers certificate as
usually. Then create a new certificate based on the original servers
certificate, but signed by your proxy CA.
This is the step where IO::Socket::SSL::Intercept helps.

=item *

Upgrade the TCP connection to the client to SSL using the cloned certificate
from the server. If the client trusts your proxy CA it will accept the upgrade
to SSL.

=item *

Transfer data between client and server. While the connections to client and
server are both encrypted with SSL you will read/write the unencrypted data in
your proxy application.

=back

=head1 METHODS 

IO::Socket::SSL::Intercept helps creating the cloned certificate with the
following methods:

=over 4

=item B<< $mitm = IO::Socket::SSL::Intercept->new(%args) >>

This creates a new interceptor object. C<%args> should be

=over 8

=item proxy_cert X509 | proxy_cert_file filename

This is the proxy certificate.
It can be either given by an X509 object from L<Net::SSLeay>s internal
representation, or using a file in PEM format.

=item proxy_key EVP_PKEY | proxy_key_file filename

This is the key for the proxy certificate.
It can be either given by an EVP_PKEY object from L<Net::SSLeay>s internal
representation, or using a file in PEM format.
The key should not have a passphrase.

=item pubkey EVP_PKEY | pubkey_file filename

This optional argument specifies the public key used for the cloned certificate.
It can be either given by an EVP_PKEY object from L<Net::SSLeay>s internal
representation, or using a file in PEM format.
If not given it will create a new public key on each call of C<new>.

=item serial INTEGER|CODE

This optional argument gives the starting point for the serial numbers of the
newly created certificates. If not set the serial number will be created based
on the digest of the original certificate. If the value is code it will be
called with C<< serial(original_cert,CERT_asHash(original_cert)) >> and should
return the new serial number.

=item cache HASH | SUBROUTINE

This optional argument gives a way to cache created certificates, so that they
don't get recreated on future accesses to the same host.
If the argument ist not given an internal HASH ist used.

If the argument is a hash it will store for each generated certificate a hash
reference with C<cert> and C<atime> in the hash, where C<atime> is the time of
last access (to expire unused entries) and C<cert> is the certificate. Please
note, that the certificate is in L<Net::SSLeay>s internal X509 format and can
thus not be simply dumped and restored.
The key for the hash is an C<ident> either given to C<clone_cert> or generated
from the original certificate.

If the argument is a subroutine it will be called as C<< $cache->(ident,sub) >>.
This call should return either an existing (cached) C<< (cert,key) >> or
call C<sub> without arguments to create a new C<< (cert,key) >>, store it
and return it.
If called with C<< $cache->('type') >> the function should just return 1 to
signal that it supports the current type of cache. If it reutrns nothing
instead the older cache interface is assumed for compatibility reasons.

=back

=item B<< ($clone_cert,$key) = $mitm->clone_cert($original_cert,[ $ident ]) >>

This clones the given certificate.
An ident as the key into the cache can be given (like C<host:port>), if not it
will be created from the properties of the original certificate.
It returns the cloned certificate and its key (which is the same for alle
created certificates).

=item B<< $string = $mitm->serialize >>

This creates a serialized version of the object (e.g. a string) which can then
be used to persistantly store created certificates over restarts of the
application. The cache will only be serialized if it is a HASH.
To work together with L<Storable> the C<STORABLE_freeze> function is defined to
call C<serialize>.

=item B<< $mitm = IO::Socket::SSL::Intercept->unserialize($string) >>

This restores an Intercept object from a serialized string.
To work together with L<Storable> the C<STORABLE_thaw> function is defined to
call C<unserialize>.

=back

=head1 AUTHOR

Steffen Ullrich
                                                                                                                                                                                                                                                                                                                                                                                                             HTML.pm                                                                                             0000644                 00000046353 00000000000 0005622 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       #---------------------------------------------------------------------
package IO::HTML;
#
# Copyright 2020 Christopher J. Madsen
#
# Author: Christopher J. Madsen <perl@cjmweb.net>
# Created: 14 Jan 2012
#
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
# 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 either the
# GNU General Public License or the Artistic License for more details.
#
# ABSTRACT: Open an HTML file with automatic charset detection
#---------------------------------------------------------------------

use 5.008;
use strict;
use warnings;

use Carp 'croak';
use Encode 2.10 qw(decode find_encoding); # need utf-8-strict encoding
use Exporter 5.57 'import';

our $VERSION = '1.004';
# This file is part of IO-HTML 1.004 (September 26, 2020)


our $bytes_to_check   ||= 1024;
our $default_encoding ||= 'cp1252';

our @EXPORT    = qw(html_file);
our @EXPORT_OK = qw(find_charset_in html_file_and_encoding html_outfile
                    sniff_encoding);

our %EXPORT_TAGS = (
  rw  => [qw( html_file html_file_and_encoding html_outfile )],
  all => [ @EXPORT, @EXPORT_OK ],
);

#=====================================================================


sub html_file
{
  (&html_file_and_encoding)[0]; # return just the filehandle
} # end html_file


# Note: I made html_file and html_file_and_encoding separate functions
# (instead of making html_file context-sensitive) because I wanted to
# use html_file in function calls (i.e. list context) without having
# to write "scalar html_file" all the time.

sub html_file_and_encoding
{
  my ($filename, $options) = @_;

  $options ||= {};

  open(my $in, '<:raw', $filename) or croak "Failed to open $filename: $!";


  my ($encoding, $bom) = sniff_encoding($in, $filename, $options);

  if (not defined $encoding) {
    croak "No default encoding specified"
        unless defined($encoding = $default_encoding);
    $encoding = find_encoding($encoding) if $options->{encoding};
  } # end if we didn't find an encoding

  binmode $in, sprintf(":encoding(%s):crlf",
                       $options->{encoding} ? $encoding->name : $encoding);

  return ($in, $encoding, $bom);
} # end html_file_and_encoding
#---------------------------------------------------------------------


sub html_outfile
{
  my ($filename, $encoding, $bom) = @_;

  if (not defined $encoding) {
    croak "No default encoding specified"
        unless defined($encoding = $default_encoding);
  } # end if we didn't find an encoding
  elsif (ref $encoding) {
    $encoding = $encoding->name;
  }

  open(my $out, ">:encoding($encoding)", $filename)
      or croak "Failed to open $filename: $!";

  print $out "\x{FeFF}" if $bom;

  return $out;
} # end html_outfile
#---------------------------------------------------------------------


sub sniff_encoding
{
  my ($in, $filename, $options) = @_;

  $filename = 'file' unless defined $filename;
  $options ||= {};

  my $pos = tell $in;
  croak "Could not seek $filename: $!" if $pos < 0;

  croak "Could not read $filename: $!"
      unless defined read $in, my($buf), $bytes_to_check;

  seek $in, $pos, 0 or croak "Could not seek $filename: $!";


  # Check for BOM:
  my $bom;
  my $encoding = do {
    if ($buf =~ /^\xFe\xFF/) {
      $bom = 2;
      'UTF-16BE';
    } elsif ($buf =~ /^\xFF\xFe/) {
      $bom = 2;
      'UTF-16LE';
    } elsif ($buf =~ /^\xEF\xBB\xBF/) {
      $bom = 3;
      'utf-8-strict';
    } else {
      find_charset_in($buf, $options); # check for <meta charset>
    }
  }; # end $encoding

  if ($bom) {
    seek $in, $bom, 1 or croak "Could not seek $filename: $!";
    $bom = 1;
  }
  elsif (not defined $encoding) { # try decoding as UTF-8
    my $test = decode('utf-8-strict', $buf, Encode::FB_QUIET);
    if ($buf =~ /^(?:                   # nothing left over
         | [\xC2-\xDF]                  # incomplete 2-byte char
         | [\xE0-\xEF] [\x80-\xBF]?     # incomplete 3-byte char
         | [\xF0-\xF4] [\x80-\xBF]{0,2} # incomplete 4-byte char
        )\z/x and $test =~ /[^\x00-\x7F]/) {
      $encoding = 'utf-8-strict';
    } # end if valid UTF-8 with at least one multi-byte character:
  } # end if testing for UTF-8

  if (defined $encoding and $options->{encoding} and not ref $encoding) {
    $encoding = find_encoding($encoding);
  } # end if $encoding is a string and we want an object

  return wantarray ? ($encoding, $bom) : $encoding;
} # end sniff_encoding

#=====================================================================
# Based on HTML5 8.2.2.2 Determining the character encoding:

# Get attribute from current position of $_
sub _get_attribute
{
  m!\G[\x09\x0A\x0C\x0D /]+!gc; # skip whitespace or /

  return if /\G>/gc or not /\G(=?[^\x09\x0A\x0C\x0D =]*)/gc;

  my ($name, $value) = (lc $1, '');

  if (/\G[\x09\x0A\x0C\x0D ]*=[\x09\x0A\x0C\x0D ]*/gc) {
    if (/\G"/gc) {
      # Double-quoted attribute value
      /\G([^"]*)("?)/gc;
      return unless $2; # Incomplete attribute (missing closing quote)
      $value = lc $1;
    } elsif (/\G'/gc) {
      # Single-quoted attribute value
      /\G([^']*)('?)/gc;
      return unless $2; # Incomplete attribute (missing closing quote)
      $value = lc $1;
    } else {
      # Unquoted attribute value
      /\G([^\x09\x0A\x0C\x0D >]*)/gc;
      $value = lc $1;
    }
  } # end if attribute has value

  return wantarray ? ($name, $value) : 1;
} # end _get_attribute

# Examine a meta value for a charset:
sub _get_charset_from_meta
{
  for (shift) {
    while (/charset[\x09\x0A\x0C\x0D ]*=[\x09\x0A\x0C\x0D ]*/ig) {
      return $1 if (/\G"([^"]*)"/gc or
                    /\G'([^']*)'/gc or
                    /\G(?!['"])([^\x09\x0A\x0C\x0D ;]+)/gc);
    }
  } # end for value

  return undef;
} # end _get_charset_from_meta
#---------------------------------------------------------------------


sub find_charset_in
{
  for (shift) {
    my $options = shift || {};
    # search only the first $bytes_to_check bytes (default 1024)
    my $stop = length > $bytes_to_check ? $bytes_to_check : length;

    my $expect_pragma = (defined $options->{need_pragma}
                         ? $options->{need_pragma} : 1);

    pos() = 0;
    while (pos() < $stop) {
      if (/\G<!--.*?(?<=--)>/sgc) {
      } # Skip comment
      elsif (m!\G<meta(?=[\x09\x0A\x0C\x0D /])!gic) {
        my ($got_pragma, $need_pragma, $charset);

        while (my ($name, $value) = &_get_attribute) {
          if ($name eq 'http-equiv' and $value eq 'content-type') {
            $got_pragma = 1;
          } elsif ($name eq 'content' and not defined $charset) {
            $need_pragma = $expect_pragma
                if defined($charset = _get_charset_from_meta($value));
          } elsif ($name eq 'charset') {
            $charset = $value;
            $need_pragma = 0;
          }
        } # end while more attributes in this <meta> tag

        if (defined $need_pragma and (not $need_pragma or $got_pragma)) {
          $charset = 'UTF-8'  if $charset =~ /^utf-?16/;
          $charset = 'cp1252' if $charset eq 'iso-8859-1'; # people lie
          if (my $encoding = find_encoding($charset)) {
            return $options->{encoding} ? $encoding : $encoding->name;
          } # end if charset is a recognized encoding
        } # end if found charset
      } # end elsif <meta
      elsif (m!\G</?[a-zA-Z][^\x09\x0A\x0C\x0D >]*!gc) {
        1 while &_get_attribute;
      } # end elsif some other tag
      elsif (m{\G<[!/?][^>]*}gc) {
      } # skip unwanted things
      elsif (m/\G</gc) {
      } # skip < that doesn't open anything we recognize

      # Advance to the next <:
      m/\G[^<]+/gc;
    } # end while not at search boundary
  } # end for string

  return undef;                 # Couldn't find a charset
} # end find_charset_in
#---------------------------------------------------------------------


# Shortcuts for people who don't like exported functions:
*file               = \&html_file;
*file_and_encoding  = \&html_file_and_encoding;
*outfile            = \&html_outfile;

#=====================================================================
# Package Return Value:

1;

__END__

=head1 NAME

IO::HTML - Open an HTML file with automatic charset detection

=head1 VERSION

This document describes version 1.004 of
IO::HTML, released September 26, 2020.

=head1 SYNOPSIS

  use IO::HTML;                 # exports html_file by default
  use HTML::TreeBuilder;

  my $tree = HTML::TreeBuilder->new_from_file(
               html_file('foo.html')
             );

  # Alternative interface:
  open(my $in, '<:raw', 'bar.html');
  my $encoding = IO::HTML::sniff_encoding($in, 'bar.html');

=head1 DESCRIPTION

IO::HTML provides an easy way to open a file containing HTML while
automatically determining its encoding.  It uses the HTML5 encoding
sniffing algorithm specified in section 8.2.2.2 of the draft standard.

The algorithm as implemented here is:

=over

=item 1.

If the file begins with a byte order mark indicating UTF-16LE,
UTF-16BE, or UTF-8, then that is the encoding.

=item 2.

If the first C<$bytes_to_check> bytes of the file contain a C<< <meta> >> tag that
indicates the charset, and Encode recognizes the specified charset
name, then that is the encoding.  (This portion of the algorithm is
implemented by C<find_charset_in>.)

The C<< <meta> >> tag can be in one of two formats:

  <meta charset="...">
  <meta http-equiv="Content-Type" content="...charset=...">

The search is case-insensitive, and the order of attributes within the
tag is irrelevant.  Any additional attributes of the tag are ignored.
The first matching tag with a recognized encoding ends the search.

=item 3.

If the first C<$bytes_to_check> bytes of the file are valid UTF-8 (with at least 1
non-ASCII character), then the encoding is UTF-8.

=item 4.

If all else fails, use the default character encoding.  The HTML5
standard suggests the default encoding should be locale dependent, but
currently it is always C<cp1252> unless you set
C<$IO::HTML::default_encoding> to a different value.  Note:
C<sniff_encoding> does not apply this step; only C<html_file> does
that.

=back

=head1 SUBROUTINES

=head2 html_file

  $filehandle = html_file($filename, \%options);

This function (exported by default) is the primary entry point.  It
opens the file specified by C<$filename> for reading, uses
C<sniff_encoding> to find a suitable encoding layer, and applies it.
It also applies the C<:crlf> layer.  If the file begins with a BOM,
the filehandle is positioned just after the BOM.

The optional second argument is a hashref containing options.  The
possible keys are described under C<find_charset_in>.

If C<sniff_encoding> is unable to determine the encoding, it defaults
to C<$IO::HTML::default_encoding>, which is set to C<cp1252>
(a.k.a. Windows-1252) by default.  According to the standard, the
default should be locale dependent, but that is not currently
implemented.

It dies if the file cannot be opened, or if C<sniff_encoding> cannot
determine the encoding and C<$IO::HTML::default_encoding> has been set
to C<undef>.


=head2 html_file_and_encoding

  ($filehandle, $encoding, $bom)
    = html_file_and_encoding($filename, \%options);

This function (exported only by request) is just like C<html_file>,
but returns more information.  In addition to the filehandle, it
returns the name of the encoding used, and a flag indicating whether a
byte order mark was found (if C<$bom> is true, the file began with a
BOM).  This may be useful if you want to write the file out again
(especially in conjunction with the C<html_outfile> function).

The optional second argument is a hashref containing options.  The
possible keys are described under C<find_charset_in>.

It dies if the file cannot be opened, or if C<sniff_encoding> cannot
determine the encoding and C<$IO::HTML::default_encoding> has been set
to C<undef>.

The result of calling C<html_file_and_encoding> in scalar context is undefined
(in the C sense of there is no guarantee what you'll get).


=head2 html_outfile

  $filehandle = html_outfile($filename, $encoding, $bom);

This function (exported only by request) opens C<$filename> for output
using C<$encoding>, and writes a BOM to it if C<$bom> is true.
If C<$encoding> is C<undef>, it defaults to C<$IO::HTML::default_encoding>.
C<$encoding> may be either an encoding name or an Encode::Encoding object.

It dies if the file cannot be opened, or if both C<$encoding> and
C<$IO::HTML::default_encoding> are C<undef>.


=head2 sniff_encoding

  ($encoding, $bom) = sniff_encoding($filehandle, $filename, \%options);

This function (exported only by request) runs the HTML5 encoding
sniffing algorithm on C<$filehandle> (which must be seekable, and
should have been opened in C<:raw> mode).  C<$filename> is used only
for error messages (if there's a problem using the filehandle), and
defaults to "file" if omitted.  The optional third argument is a
hashref containing options.  The possible keys are described under
C<find_charset_in>.

It returns Perl's canonical name for the encoding, which is not
necessarily the same as the MIME or IANA charset name.  It returns
C<undef> if the encoding cannot be determined.  C<$bom> is true if the
file began with a byte order mark.  In scalar context, it returns only
C<$encoding>.

The filehandle's position is restored to its original position
(normally the beginning of the file) unless C<$bom> is true.  In that
case, the position is immediately after the BOM.

Tip: If you want to run C<sniff_encoding> on a file you've already
loaded into a string, open an in-memory file on the string, and pass
that handle:

  ($encoding, $bom) = do {
    open(my $fh, '<', \$string);  sniff_encoding($fh)
  };

(This only makes sense if C<$string> contains bytes, not characters.)


=head2 find_charset_in

  $encoding = find_charset_in($string_containing_HTML, \%options);

This function (exported only by request) looks for charset information
in a C<< <meta> >> tag in a possibly-incomplete HTML document using
the "two step" algorithm specified by HTML5.  It does not look for a BOM.
The C<< <meta> >> tag must begin within the first C<$IO::HTML::bytes_to_check>
bytes of the string.

It returns Perl's canonical name for the encoding, which is not
necessarily the same as the MIME or IANA charset name.  It returns
C<undef> if no charset is specified or if the specified charset is not
recognized by the Encode module.

The optional second argument is a hashref containing options.  The
following keys are recognized:

=over

=item C<encoding>

If true, return the L<Encode::Encoding> object instead of its name.
Defaults to false.

=item C<need_pragma>

If true (the default), follow the HTML5 spec and examine the
C<content> attribute only of C<< <meta http-equiv="Content-Type" >>.
If set to 0, relax the HTML5 spec, and look for "charset=" in the
C<content> attribute of I<every> meta tag.

=back

=head1 EXPORTS

By default, only C<html_file> is exported.  Other functions may be
exported on request.

For people who prefer not to export functions, all functions beginning
with C<html_> have an alias without that prefix (e.g. you can call
C<IO::HTML::file(...)> instead of C<IO::HTML::html_file(...)>.  These
aliases are not exportable.

=for Pod::Coverage
file
file_and_encoding
outfile

The following export tags are available:

=over

=item C<:all>

All exportable functions.

=item C<:rw>

C<html_file>, C<html_file_and_encoding>, C<html_outfile>.

=back

=head1 SEE ALSO

The HTML5 specification, section 8.2.2.2 Determining the character encoding:
L<http://www.w3.org/TR/html5/syntax.html#determining-the-character-encoding>

=head1 DIAGNOSTICS

=over

=item C<< Could not read %s: %s >>

The specified file could not be read from for the reason specified by C<$!>.


=item C<< Could not seek %s: %s >>

The specified file could not be rewound for the reason specified by C<$!>.


=item C<< Failed to open %s: %s >>

The specified file could not be opened for reading for the reason
specified by C<$!>.


=item C<< No default encoding specified >>

The C<sniff_encoding> algorithm didn't find an encoding to use, and
you set C<$IO::HTML::default_encoding> to C<undef>.


=back

=head1 CONFIGURATION AND ENVIRONMENT

There are two global variables that affect IO::HTML.  If you need to
change them, you should do so using C<local> if possible:

  my $file = do {
    # This file may define the charset later in the header
    local $IO::HTML::bytes_to_check = 4096;
    html_file(...);
  };

=over

=item C<$bytes_to_check>

This is the number of bytes that C<sniff_encoding> will read from the
stream.  It is also the number of bytes that C<find_charset_in> will
search for a C<< <meta> >> tag containing charset information.
It must be a positive integer.

The HTML 5 specification recommends using the default value of 1024,
but some pages do not follow the specification.

=item C<$default_encoding>

This is the encoding that C<html_file> and C<html_file_and_encoding>
will use if no encoding can be detected by C<sniff_encoding>.
The default value is C<cp1252> (a.k.a. Windows-1252).

Setting it to C<undef> will cause the file subroutines to croak if
C<sniff_encoding> fails to determine the encoding.  (C<sniff_encoding>
itself does not use C<$default_encoding>).

=back

=head1 DEPENDENCIES

IO::HTML has no non-core dependencies for Perl 5.8.7+.  With earlier
versions of Perl 5.8, you need to upgrade L<Encode> to at least
version 2.10, and
you may need to upgrade L<Exporter> to at least version
5.57.

=head1 INCOMPATIBILITIES

None reported.

=head1 BUGS AND LIMITATIONS

No bugs have been reported.

=head1 AUTHOR

Christopher J. Madsen  S<C<< <perl AT cjmweb.net> >>>

Please report any bugs or feature requests
to S<C<< <bug-IO-HTML AT rt.cpan.org> >>>
or through the web interface at
L<< http://rt.cpan.org/Public/Bug/Report.html?Queue=IO-HTML >>.

You can follow or contribute to IO-HTML's development at
L<< https://github.com/madsen/io-html >>.

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2020 by Christopher J. Madsen.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=head1 DISCLAIMER OF WARRANTY

BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
NECESSARY SERVICING, REPAIR, OR CORRECTION.

IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENSE, BE
LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
SUCH DAMAGES.

=cut
                                                                                                                                                                                                                                                                                     Socket/IP.pm                                                                                        0000644                 00000120365 00000000000 0006612 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       #  You may distribute under the terms of either the GNU General Public License
#  or the Artistic License (the same terms as Perl itself)
#
#  (C) Paul Evans, 2010-2020 -- leonerd@leonerd.org.uk

package IO::Socket::IP;

use v5;
use strict;
use warnings;

# $VERSION needs to be set before  use base 'IO::Socket'
#  - https://rt.cpan.org/Ticket/Display.html?id=92107
BEGIN {
   our $VERSION = '0.41';
}

use base qw( IO::Socket );

use Carp;

use Socket 1.97 qw(
   getaddrinfo getnameinfo
   sockaddr_family
   AF_INET
   AI_PASSIVE
   IPPROTO_TCP IPPROTO_UDP
   IPPROTO_IPV6 IPV6_V6ONLY
   NI_DGRAM NI_NUMERICHOST NI_NUMERICSERV NIx_NOHOST NIx_NOSERV
   SO_REUSEADDR SO_REUSEPORT SO_BROADCAST SO_ERROR
   SOCK_DGRAM SOCK_STREAM
   SOL_SOCKET
);
my $AF_INET6 = eval { Socket::AF_INET6() }; # may not be defined
my $AI_ADDRCONFIG = eval { Socket::AI_ADDRCONFIG() } || 0;
my $AI_NUMERICHOST = eval { Socket::AI_NUMERICHOST() } || 0;
use POSIX qw( dup2 );
use Errno qw( EINVAL EINPROGRESS EISCONN ENOTCONN ETIMEDOUT EWOULDBLOCK EOPNOTSUPP );

use constant HAVE_MSWIN32 => ( $^O eq "MSWin32" );

# At least one OS (Android) is known not to have getprotobyname()
use constant HAVE_GETPROTOBYNAME => defined eval { getprotobyname( "tcp" ) };

my $IPv6_re = do {
   # translation of RFC 3986 3.2.2 ABNF to re
   my $IPv4address = do {
      my $dec_octet = q<(?:[0-9]|[1-9][0-9]|1[0-9][0-9]|2[0-4][0-9]|25[0-5])>;
      qq<$dec_octet(?: \\. $dec_octet){3}>;
   };
   my $IPv6address = do {
      my $h16  = qq<[0-9A-Fa-f]{1,4}>;
      my $ls32 = qq<(?: $h16 : $h16 | $IPv4address)>;
      qq<(?:
                                            (?: $h16 : ){6} $ls32
         |                               :: (?: $h16 : ){5} $ls32
         | (?:                   $h16 )? :: (?: $h16 : ){4} $ls32
         | (?: (?: $h16 : ){0,1} $h16 )? :: (?: $h16 : ){3} $ls32
         | (?: (?: $h16 : ){0,2} $h16 )? :: (?: $h16 : ){2} $ls32
         | (?: (?: $h16 : ){0,3} $h16 )? ::     $h16 :      $ls32
         | (?: (?: $h16 : ){0,4} $h16 )? ::                 $ls32
         | (?: (?: $h16 : ){0,5} $h16 )? ::                 $h16
         | (?: (?: $h16 : ){0,6} $h16 )? ::
      )>
   };
   qr<$IPv6address>xo;
};

=head1 NAME

C<IO::Socket::IP> - Family-neutral IP socket supporting both IPv4 and IPv6

=head1 SYNOPSIS

 use IO::Socket::IP;

 my $sock = IO::Socket::IP->new(
    PeerHost => "www.google.com",
    PeerPort => "http",
    Type     => SOCK_STREAM,
 ) or die "Cannot construct socket - $@";

 my $familyname = ( $sock->sockdomain == PF_INET6 ) ? "IPv6" :
                  ( $sock->sockdomain == PF_INET  ) ? "IPv4" :
                                                      "unknown";

 printf "Connected to google via %s\n", $familyname;

=head1 DESCRIPTION

This module provides a protocol-independent way to use IPv4 and IPv6 sockets,
intended as a replacement for L<IO::Socket::INET>. Most constructor arguments
and methods are provided in a backward-compatible way. For a list of known
differences, see the C<IO::Socket::INET> INCOMPATIBILITES section below.

It uses the C<getaddrinfo(3)> function to convert hostnames and service names
or port numbers into sets of possible addresses to connect to or listen on.
This allows it to work for IPv6 where the system supports it, while still
falling back to IPv4-only on systems which don't.

=head1 REPLACING C<IO::Socket> DEFAULT BEHAVIOUR

By placing C<-register> in the import list to C<IO::Socket::IP>, it will
register itself with L<IO::Socket> as the class that handles C<PF_INET>. It
will also ask to handle C<PF_INET6> as well, provided that constant is
available.

Changing C<IO::Socket>'s default behaviour means that calling the
C<IO::Socket> constructor with either C<PF_INET> or C<PF_INET6> as the
C<Domain> parameter will yield an C<IO::Socket::IP> object.

 use IO::Socket::IP -register;

 my $sock = IO::Socket->new(
    Domain    => PF_INET6,
    LocalHost => "::1",
    Listen    => 1,
 ) or die "Cannot create socket - $@\n";

 print "Created a socket of type " . ref($sock) . "\n";

Note that C<-register> is a global setting that applies to the entire program;
it cannot be applied only for certain callers, removed, or limited by lexical
scope.

=cut

sub import
{
   my $pkg = shift;
   my @symbols;

   foreach ( @_ ) {
      if( $_ eq "-register" ) {
         IO::Socket::IP::_ForINET->register_domain( AF_INET );
         IO::Socket::IP::_ForINET6->register_domain( $AF_INET6 ) if defined $AF_INET6;
      }
      else {
         push @symbols, $_;
      }
   }

   @_ = ( $pkg, @symbols );
   goto &IO::Socket::import;
}

# Convenient capability test function
{
   my $can_disable_v6only;
   sub CAN_DISABLE_V6ONLY
   {
      return $can_disable_v6only if defined $can_disable_v6only;

      socket my $testsock, Socket::PF_INET6(), SOCK_STREAM, 0 or
         die "Cannot socket(PF_INET6) - $!";

      if( setsockopt $testsock, IPPROTO_IPV6, IPV6_V6ONLY, 0 ) {
         return $can_disable_v6only = 1;
      }
      elsif( $! == EINVAL || $! == EOPNOTSUPP ) {
         return $can_disable_v6only = 0;
      }
      else {
         die "Cannot setsockopt() - $!";
      }
   }
}

=head1 CONSTRUCTORS

=cut

=head2 new

   $sock = IO::Socket::IP->new( %args )

Creates a new C<IO::Socket::IP> object, containing a newly created socket
handle according to the named arguments passed. The recognised arguments are:

=over 8

=item PeerHost => STRING

=item PeerService => STRING

Hostname and service name for the peer to C<connect()> to. The service name
may be given as a port number, as a decimal string.

=item PeerAddr => STRING

=item PeerPort => STRING

For symmetry with the accessor methods and compatibility with
C<IO::Socket::INET>, these are accepted as synonyms for C<PeerHost> and
C<PeerService> respectively.

=item PeerAddrInfo => ARRAY

Alternate form of specifying the peer to C<connect()> to. This should be an
array of the form returned by C<Socket::getaddrinfo>.

This parameter takes precedence over the C<Peer*>, C<Family>, C<Type> and
C<Proto> arguments.

=item LocalHost => STRING

=item LocalService => STRING

Hostname and service name for the local address to C<bind()> to.

=item LocalAddr => STRING

=item LocalPort => STRING

For symmetry with the accessor methods and compatibility with
C<IO::Socket::INET>, these are accepted as synonyms for C<LocalHost> and
C<LocalService> respectively.

=item LocalAddrInfo => ARRAY

Alternate form of specifying the local address to C<bind()> to. This should be
an array of the form returned by C<Socket::getaddrinfo>.

This parameter takes precedence over the C<Local*>, C<Family>, C<Type> and
C<Proto> arguments.

=item Family => INT

The address family to pass to C<getaddrinfo> (e.g. C<AF_INET>, C<AF_INET6>).
Normally this will be left undefined, and C<getaddrinfo> will search using any
address family supported by the system.

=item Type => INT

The socket type to pass to C<getaddrinfo> (e.g. C<SOCK_STREAM>,
C<SOCK_DGRAM>). Normally defined by the caller; if left undefined
C<getaddrinfo> may attempt to infer the type from the service name.

=item Proto => STRING or INT

The IP protocol to use for the socket (e.g. C<'tcp'>, C<IPPROTO_TCP>,
C<'udp'>,C<IPPROTO_UDP>). Normally this will be left undefined, and either
C<getaddrinfo> or the kernel will choose an appropriate value. May be given
either in string name or numeric form.

=item GetAddrInfoFlags => INT

More flags to pass to the C<getaddrinfo()> function. If not supplied, a
default of C<AI_ADDRCONFIG> will be used.

These flags will be combined with C<AI_PASSIVE> if the C<Listen> argument is
given. For more information see the documentation about C<getaddrinfo()> in
the L<Socket> module.

=item Listen => INT

If defined, puts the socket into listening mode where new connections can be
accepted using the C<accept> method. The value given is used as the
C<listen(2)> queue size.

=item ReuseAddr => BOOL

If true, set the C<SO_REUSEADDR> sockopt

=item ReusePort => BOOL

If true, set the C<SO_REUSEPORT> sockopt (not all OSes implement this sockopt)

=item Broadcast => BOOL

If true, set the C<SO_BROADCAST> sockopt

=item Sockopts => ARRAY

An optional array of other socket options to apply after the three listed
above. The value is an ARRAY containing 2- or 3-element ARRAYrefs. Each inner
array relates to a single option, giving the level and option name, and an
optional value. If the value element is missing, it will be given the value of
a platform-sized integer 1 constant (i.e. suitable to enable most of the
common boolean options).

For example, both options given below are equivalent to setting C<ReuseAddr>.

 Sockopts => [
    [ SOL_SOCKET, SO_REUSEADDR ],
    [ SOL_SOCKET, SO_REUSEADDR, pack( "i", 1 ) ],
 ]

=item V6Only => BOOL

If defined, set the C<IPV6_V6ONLY> sockopt when creating C<PF_INET6> sockets
to the given value. If true, a listening-mode socket will only listen on the
C<AF_INET6> addresses; if false it will also accept connections from
C<AF_INET> addresses.

If not defined, the socket option will not be changed, and default value set
by the operating system will apply. For repeatable behaviour across platforms
it is recommended this value always be defined for listening-mode sockets.

Note that not all platforms support disabling this option. Some, at least
OpenBSD and MirBSD, will fail with C<EINVAL> if you attempt to disable it.
To determine whether it is possible to disable, you may use the class method

 if( IO::Socket::IP->CAN_DISABLE_V6ONLY ) {
    ...
 }
 else {
    ...
 }

If your platform does not support disabling this option but you still want to
listen for both C<AF_INET> and C<AF_INET6> connections you will have to create
two listening sockets, one bound to each protocol.

=item MultiHomed

This C<IO::Socket::INET>-style argument is ignored, except if it is defined
but false. See the C<IO::Socket::INET> INCOMPATIBILITES section below.

However, the behaviour it enables is always performed by C<IO::Socket::IP>.

=item Blocking => BOOL

If defined but false, the socket will be set to non-blocking mode. Otherwise
it will default to blocking mode. See the NON-BLOCKING section below for more
detail.

=item Timeout => NUM

If defined, gives a maximum time in seconds to block per C<connect()> call
when in blocking mode. If missing, no timeout is applied other than that
provided by the underlying operating system. When in non-blocking mode this
parameter is ignored.

Note that if the hostname resolves to multiple address candidates, the same
timeout will apply to each connection attempt individually, rather than to the
operation as a whole. Further note that the timeout does not apply to the
initial hostname resolve operation, if connecting by hostname.

This behviour is copied inspired by C<IO::Socket::INET>; for more fine grained
control over connection timeouts, consider performing a nonblocking connect
directly.

=back

If neither C<Type> nor C<Proto> hints are provided, a default of
C<SOCK_STREAM> and C<IPPROTO_TCP> respectively will be set, to maintain
compatibility with C<IO::Socket::INET>. Other named arguments that are not
recognised are ignored.

If neither C<Family> nor any hosts or addresses are passed, nor any
C<*AddrInfo>, then the constructor has no information on which to decide a
socket family to create. In this case, it performs a C<getaddinfo> call with
the C<AI_ADDRCONFIG> flag, no host name, and a service name of C<"0">, and
uses the family of the first returned result.

If the constructor fails, it will set C<$@> to an appropriate error message;
this may be from C<$!> or it may be some other string; not every failure
necessarily has an associated C<errno> value.

=head2 new (one arg)

   $sock = IO::Socket::IP->new( $peeraddr )

As a special case, if the constructor is passed a single argument (as
opposed to an even-sized list of key/value pairs), it is taken to be the value
of the C<PeerAddr> parameter. This is parsed in the same way, according to the
behaviour given in the C<PeerHost> AND C<LocalHost> PARSING section below.

=cut

sub new
{
   my $class = shift;
   my %arg = (@_ == 1) ? (PeerHost => $_[0]) : @_;
   return $class->SUPER::new(%arg);
}

# IO::Socket may call this one; neaten up the arguments from IO::Socket::INET
# before calling our real _configure method
sub configure
{
   my $self = shift;
   my ( $arg ) = @_;

   $arg->{PeerHost} = delete $arg->{PeerAddr}
      if exists $arg->{PeerAddr} && !exists $arg->{PeerHost};

   $arg->{PeerService} = delete $arg->{PeerPort}
      if exists $arg->{PeerPort} && !exists $arg->{PeerService};

   $arg->{LocalHost} = delete $arg->{LocalAddr}
      if exists $arg->{LocalAddr} && !exists $arg->{LocalHost};

   $arg->{LocalService} = delete $arg->{LocalPort}
      if exists $arg->{LocalPort} && !exists $arg->{LocalService};

   for my $type (qw(Peer Local)) {
      my $host    = $type . 'Host';
      my $service = $type . 'Service';

      if( defined $arg->{$host} ) {
         ( $arg->{$host}, my $s ) = $self->split_addr( $arg->{$host} );
         # IO::Socket::INET compat - *Host parsed port always takes precedence
         $arg->{$service} = $s if defined $s;
      }
   }

   $self->_io_socket_ip__configure( $arg );
}

# Avoid simply calling it _configure, as some subclasses of IO::Socket::INET on CPAN already take that
sub _io_socket_ip__configure
{
   my $self = shift;
   my ( $arg ) = @_;

   my %hints;
   my $localflags;
   my $peerflags;
   my @localinfos;
   my @peerinfos;

   my $listenqueue = $arg->{Listen};
   if( defined $listenqueue and
       ( defined $arg->{PeerHost} || defined $arg->{PeerService} || defined $arg->{PeerAddrInfo} ) ) {
      croak "Cannot Listen with a peer address";
   }

   if( defined $arg->{GetAddrInfoFlags} ) {
      $hints{flags} = $arg->{GetAddrInfoFlags};
      $localflags  = $arg->{GetAddrInfoFlags};
      $peerflags  = $arg->{GetAddrInfoFlags};
   }
   else {
      if (defined $arg->{LocalHost} and $arg->{LocalHost} =~ /^\d+\.\d+\.\d+\.\d+$/) {
              $localflags = $AI_NUMERICHOST;
      } else {
              $localflags = $AI_ADDRCONFIG;
      }
      if (defined $arg->{PeerHost} and $arg->{PeerHost} =~ /^\d+\.\d+\.\d+\.\d+$/) {
              $peerflags = $AI_NUMERICHOST;
      } elsif (defined $arg->{PeerHost} and $arg->{PeerHost} ne 'localhost') {
              $peerflags = $AI_ADDRCONFIG;
      }
   }

   if( defined( my $family = $arg->{Family} ) ) {
      $hints{family} = $family;
   }

   if( defined( my $type = $arg->{Type} ) ) {
      $hints{socktype} = $type;
   }

   if( defined( my $proto = $arg->{Proto} ) ) {
      unless( $proto =~ m/^\d+$/ ) {
         my $protonum = HAVE_GETPROTOBYNAME
            ? getprotobyname( $proto )
            : eval { Socket->${\"IPPROTO_\U$proto"}() };
         defined $protonum or croak "Unrecognised protocol $proto";
         $proto = $protonum;
      }

      $hints{protocol} = $proto;
   }

   # To maintain compatibility with IO::Socket::INET, imply a default of
   # SOCK_STREAM + IPPROTO_TCP if neither hint is given
   if( !defined $hints{socktype} and !defined $hints{protocol} ) {
      $hints{socktype} = SOCK_STREAM;
      $hints{protocol} = IPPROTO_TCP;
   }

   # Some OSes (NetBSD) don't seem to like just a protocol hint without a
   # socktype hint as well. We'll set a couple of common ones
   if( !defined $hints{socktype} and defined $hints{protocol} ) {
      $hints{socktype} = SOCK_STREAM if $hints{protocol} == IPPROTO_TCP;
      $hints{socktype} = SOCK_DGRAM  if $hints{protocol} == IPPROTO_UDP;
   }

   if( my $info = $arg->{LocalAddrInfo} ) {
      ref $info eq "ARRAY" or croak "Expected 'LocalAddrInfo' to be an ARRAY ref";
      @localinfos = @$info;
   }
   elsif( defined $arg->{LocalHost} or
          defined $arg->{LocalService} or
          HAVE_MSWIN32 and $arg->{Listen} ) {
      # Either may be undef
      my $host = $arg->{LocalHost};
      my $service = $arg->{LocalService};

      unless ( defined $host or defined $service ) {
         $service = 0;
      }

      local $1; # Placate a taint-related bug; [perl #67962]
      defined $service and $service =~ s/\((\d+)\)$// and
         my $fallback_port = $1;

      my %localhints = %hints;
      $localhints{flags} = $localflags;
      $localhints{flags} |= AI_PASSIVE;
      ( my $err, @localinfos ) = getaddrinfo( $host, $service, \%localhints );

      if( $err and defined $fallback_port ) {
         ( $err, @localinfos ) = getaddrinfo( $host, $fallback_port, \%localhints );
      }

      if( $err ) {
         $@ = "$err";
         $! = EINVAL;
         return;
      }
   }

   if( my $info = $arg->{PeerAddrInfo} ) {
      ref $info eq "ARRAY" or croak "Expected 'PeerAddrInfo' to be an ARRAY ref";
      @peerinfos = @$info;
   }
   elsif( defined $arg->{PeerHost} or defined $arg->{PeerService} ) {
      defined( my $host = $arg->{PeerHost} ) or
         croak "Expected 'PeerHost'";
      defined( my $service = $arg->{PeerService} ) or
         croak "Expected 'PeerService'";

      local $1; # Placate a taint-related bug; [perl #67962]
      defined $service and $service =~ s/\((\d+)\)$// and
         my $fallback_port = $1;

      my %peerhints = %hints;
      $peerhints{flags} = $peerflags;
      ( my $err, @peerinfos ) = getaddrinfo( $host, $service, \%peerhints );

      if( $err and defined $fallback_port ) {
         ( $err, @peerinfos ) = getaddrinfo( $host, $fallback_port, \%peerhints );
      }

      if( $err ) {
         $@ = "$err";
         $! = EINVAL;
         return;
      }
   }

   my $INT_1 = pack "i", 1;

   my @sockopts_enabled;
   push @sockopts_enabled, [ SOL_SOCKET, SO_REUSEADDR, $INT_1 ] if $arg->{ReuseAddr};
   push @sockopts_enabled, [ SOL_SOCKET, SO_REUSEPORT, $INT_1 ] if $arg->{ReusePort};
   push @sockopts_enabled, [ SOL_SOCKET, SO_BROADCAST, $INT_1 ] if $arg->{Broadcast};

   if( my $sockopts = $arg->{Sockopts} ) {
      ref $sockopts eq "ARRAY" or croak "Expected 'Sockopts' to be an ARRAY ref";
      foreach ( @$sockopts ) {
         ref $_ eq "ARRAY" or croak "Bad Sockopts item - expected ARRAYref";
         @$_ >= 2 and @$_ <= 3 or
            croak "Bad Sockopts item - expected 2 or 3 elements";

         my ( $level, $optname, $value ) = @$_;
         # TODO: consider more sanity checking on argument values

         defined $value or $value = $INT_1;
         push @sockopts_enabled, [ $level, $optname, $value ];
      }
   }

   my $blocking = $arg->{Blocking};
   defined $blocking or $blocking = 1;

   my $v6only = $arg->{V6Only};

   # IO::Socket::INET defines this key. IO::Socket::IP always implements the
   # behaviour it requests, so we can ignore it, unless the caller is for some
   # reason asking to disable it.
   if( defined $arg->{MultiHomed} and !$arg->{MultiHomed} ) {
      croak "Cannot disable the MultiHomed parameter";
   }

   my @infos;
   foreach my $local ( @localinfos ? @localinfos : {} ) {
      foreach my $peer ( @peerinfos ? @peerinfos : {} ) {
         next if defined $local->{family}   and defined $peer->{family}   and
            $local->{family} != $peer->{family};
         next if defined $local->{socktype} and defined $peer->{socktype} and
            $local->{socktype} != $peer->{socktype};
         next if defined $local->{protocol} and defined $peer->{protocol} and
            $local->{protocol} != $peer->{protocol};

         my $family   = $local->{family}   || $peer->{family}   or next;
         my $socktype = $local->{socktype} || $peer->{socktype} or next;
         my $protocol = $local->{protocol} || $peer->{protocol} || 0;

         push @infos, {
            family    => $family,
            socktype  => $socktype,
            protocol  => $protocol,
            localaddr => $local->{addr},
            peeraddr  => $peer->{addr},
         };
      }
   }

   if( !@infos ) {
      # If there was a Family hint then create a plain unbound, unconnected socket
      if( defined $hints{family} ) {
         @infos = ( {
            family   => $hints{family},
            socktype => $hints{socktype},
            protocol => $hints{protocol},
         } );
      }
      # If there wasn't, use getaddrinfo()'s AI_ADDRCONFIG side-effect to guess a
      # suitable family first.
      else {
         $hints{flags} |= $AI_ADDRCONFIG;
         ( my $err, @infos ) = getaddrinfo( "", "0", \%hints );
         if( $err ) {
            $@ = "$err";
            $! = EINVAL;
            return;
         }

         # We'll take all the @infos anyway, because some OSes (HPUX) are known to
         # ignore the AI_ADDRCONFIG hint and return AF_INET6 even if they don't
         # support them
      }
   }

   # In the nonblocking case, caller will be calling ->setup multiple times.
   # Store configuration in the object for the ->setup method
   # Yes, these are messy. Sorry, I can't help that...

   ${*$self}{io_socket_ip_infos} = \@infos;

   ${*$self}{io_socket_ip_idx} = -1;

   ${*$self}{io_socket_ip_sockopts} = \@sockopts_enabled;
   ${*$self}{io_socket_ip_v6only} = $v6only;
   ${*$self}{io_socket_ip_listenqueue} = $listenqueue;
   ${*$self}{io_socket_ip_blocking} = $blocking;

   ${*$self}{io_socket_ip_errors} = [ undef, undef, undef ];

   # ->setup is allowed to return false in nonblocking mode
   $self->setup or !$blocking or return undef;

   return $self;
}

sub setup
{
   my $self = shift;

   while(1) {
      ${*$self}{io_socket_ip_idx}++;
      last if ${*$self}{io_socket_ip_idx} >= @{ ${*$self}{io_socket_ip_infos} };

      my $info = ${*$self}{io_socket_ip_infos}->[${*$self}{io_socket_ip_idx}];

      $self->socket( @{$info}{qw( family socktype protocol )} ) or
         ( ${*$self}{io_socket_ip_errors}[2] = $!, next );

      $self->blocking( 0 ) unless ${*$self}{io_socket_ip_blocking};

      foreach my $sockopt ( @{ ${*$self}{io_socket_ip_sockopts} } ) {
         my ( $level, $optname, $value ) = @$sockopt;
         $self->setsockopt( $level, $optname, $value ) or ( $@ = "$!", return undef );
      }

      if( defined ${*$self}{io_socket_ip_v6only} and defined $AF_INET6 and $info->{family} == $AF_INET6 ) {
         my $v6only = ${*$self}{io_socket_ip_v6only};
         $self->setsockopt( IPPROTO_IPV6, IPV6_V6ONLY, pack "i", $v6only ) or ( $@ = "$!", return undef );
      }

      if( defined( my $addr = $info->{localaddr} ) ) {
         $self->bind( $addr ) or
            ( ${*$self}{io_socket_ip_errors}[1] = $!, next );
      }

      if( defined( my $listenqueue = ${*$self}{io_socket_ip_listenqueue} ) ) {
         $self->listen( $listenqueue ) or ( $@ = "$!", return undef );
      }

      if( defined( my $addr = $info->{peeraddr} ) ) {
         if( $self->connect( $addr ) ) {
            $! = 0;
            return 1;
         }

         if( $! == EINPROGRESS or $! == EWOULDBLOCK ) {
            ${*$self}{io_socket_ip_connect_in_progress} = 1;
            return 0;
         }

         # If connect failed but we have no system error there must be an error
         # at the application layer, like a bad certificate with
         # IO::Socket::SSL.
         # In this case don't continue IP based multi-homing because the problem
         # cannot be solved at the IP layer.
         return 0 if ! $!;

         ${*$self}{io_socket_ip_errors}[0] = $!;
         next;
      }

      return 1;
   }

   # Pick the most appropriate error, stringified
   $! = ( grep defined, @{ ${*$self}{io_socket_ip_errors}} )[0];
   $@ = "$!";
   return undef;
}

sub connect :method
{
   my $self = shift;

   # It seems that IO::Socket hides EINPROGRESS errors, making them look like
   # a success. This is annoying here.
   # Instead of putting up with its frankly-irritating intentional breakage of
   # useful APIs I'm just going to end-run around it and call core's connect()
   # directly

   if( @_ ) {
      my ( $addr ) = @_;

      # Annoyingly IO::Socket's connect() is where the timeout logic is
      # implemented, so we'll have to reinvent it here
      my $timeout = ${*$self}{'io_socket_timeout'};

      return connect( $self, $addr ) unless defined $timeout;

      my $was_blocking = $self->blocking( 0 );

      my $err = defined connect( $self, $addr ) ? 0 : $!+0;

      if( !$err ) {
         # All happy
         $self->blocking( $was_blocking );
         return 1;
      }
      elsif( not( $err == EINPROGRESS or $err == EWOULDBLOCK ) ) {
         # Failed for some other reason
         $self->blocking( $was_blocking );
         return undef;
      }
      elsif( !$was_blocking ) {
         # We shouldn't block anyway
         return undef;
      }

      my $vec = ''; vec( $vec, $self->fileno, 1 ) = 1;
      if( !select( undef, $vec, $vec, $timeout ) ) {
         $self->blocking( $was_blocking );
         $! = ETIMEDOUT;
         return undef;
      }

      # Hoist the error by connect()ing a second time
      $err = $self->getsockopt( SOL_SOCKET, SO_ERROR );
      $err = 0 if $err == EISCONN; # Some OSes give EISCONN

      $self->blocking( $was_blocking );

      $! = $err, return undef if $err;
      return 1;
   }

   return 1 if !${*$self}{io_socket_ip_connect_in_progress};

   # See if a connect attempt has just failed with an error
   if( my $errno = $self->getsockopt( SOL_SOCKET, SO_ERROR ) ) {
      delete ${*$self}{io_socket_ip_connect_in_progress};
      ${*$self}{io_socket_ip_errors}[0] = $! = $errno;
      return $self->setup;
   }

   # No error, so either connect is still in progress, or has completed
   # successfully. We can tell by trying to connect() again; either it will
   # succeed or we'll get EISCONN (connected successfully), or EALREADY
   # (still in progress). This even works on MSWin32.
   my $addr = ${*$self}{io_socket_ip_infos}[${*$self}{io_socket_ip_idx}]{peeraddr};

   if( connect( $self, $addr ) or $! == EISCONN ) {
      delete ${*$self}{io_socket_ip_connect_in_progress};
      $! = 0;
      return 1;
   }
   else {
      $! = EINPROGRESS;
      return 0;
   }
}

sub connected
{
   my $self = shift;
   return defined $self->fileno &&
          !${*$self}{io_socket_ip_connect_in_progress} &&
          defined getpeername( $self ); # ->peername caches, we need to detect disconnection
}

=head1 METHODS

As well as the following methods, this class inherits all the methods in
L<IO::Socket> and L<IO::Handle>.

=cut

sub _get_host_service
{
   my $self = shift;
   my ( $addr, $flags, $xflags ) = @_;

   defined $addr or
      $! = ENOTCONN, return;

   $flags |= NI_DGRAM if $self->socktype == SOCK_DGRAM;

   my ( $err, $host, $service ) = getnameinfo( $addr, $flags, $xflags || 0 );
   croak "getnameinfo - $err" if $err;

   return ( $host, $service );
}

sub _unpack_sockaddr
{
   my ( $addr ) = @_;
   my $family = sockaddr_family $addr;

   if( $family == AF_INET ) {
      return ( Socket::unpack_sockaddr_in( $addr ) )[1];
   }
   elsif( defined $AF_INET6 and $family == $AF_INET6 ) {
      return ( Socket::unpack_sockaddr_in6( $addr ) )[1];
   }
   else {
      croak "Unrecognised address family $family";
   }
}

=head2 sockhost_service

   ( $host, $service ) = $sock->sockhost_service( $numeric )

Returns the hostname and service name of the local address (that is, the
socket address given by the C<sockname> method).

If C<$numeric> is true, these will be given in numeric form rather than being
resolved into names.

The following four convenience wrappers may be used to obtain one of the two
values returned here. If both host and service names are required, this method
is preferable to the following wrappers, because it will call
C<getnameinfo(3)> only once.

=cut

sub sockhost_service
{
   my $self = shift;
   my ( $numeric ) = @_;

   $self->_get_host_service( $self->sockname, $numeric ? NI_NUMERICHOST|NI_NUMERICSERV : 0 );
}

=head2 sockhost

   $addr = $sock->sockhost

Return the numeric form of the local address as a textual representation

=head2 sockport

   $port = $sock->sockport

Return the numeric form of the local port number

=head2 sockhostname

   $host = $sock->sockhostname

Return the resolved name of the local address

=head2 sockservice

   $service = $sock->sockservice

Return the resolved name of the local port number

=cut

sub sockhost { my $self = shift; scalar +( $self->_get_host_service( $self->sockname, NI_NUMERICHOST, NIx_NOSERV ) )[0] }
sub sockport { my $self = shift; scalar +( $self->_get_host_service( $self->sockname, NI_NUMERICSERV, NIx_NOHOST ) )[1] }

sub sockhostname { my $self = shift; scalar +( $self->_get_host_service( $self->sockname, 0, NIx_NOSERV ) )[0] }
sub sockservice  { my $self = shift; scalar +( $self->_get_host_service( $self->sockname, 0, NIx_NOHOST ) )[1] }

=head2 sockaddr

   $addr = $sock->sockaddr

Return the local address as a binary octet string

=cut

sub sockaddr { my $self = shift; _unpack_sockaddr $self->sockname }

=head2 peerhost_service

   ( $host, $service ) = $sock->peerhost_service( $numeric )

Returns the hostname and service name of the peer address (that is, the
socket address given by the C<peername> method), similar to the
C<sockhost_service> method.

The following four convenience wrappers may be used to obtain one of the two
values returned here. If both host and service names are required, this method
is preferable to the following wrappers, because it will call
C<getnameinfo(3)> only once.

=cut

sub peerhost_service
{
   my $self = shift;
   my ( $numeric ) = @_;

   $self->_get_host_service( $self->peername, $numeric ? NI_NUMERICHOST|NI_NUMERICSERV : 0 );
}

=head2 peerhost

   $addr = $sock->peerhost

Return the numeric form of the peer address as a textual representation

=head2 peerport

   $port = $sock->peerport

Return the numeric form of the peer port number

=head2 peerhostname

   $host = $sock->peerhostname

Return the resolved name of the peer address

=head2 peerservice

   $service = $sock->peerservice

Return the resolved name of the peer port number

=cut

sub peerhost { my $self = shift; scalar +( $self->_get_host_service( $self->peername, NI_NUMERICHOST, NIx_NOSERV ) )[0] }
sub peerport { my $self = shift; scalar +( $self->_get_host_service( $self->peername, NI_NUMERICSERV, NIx_NOHOST ) )[1] }

sub peerhostname { my $self = shift; scalar +( $self->_get_host_service( $self->peername, 0, NIx_NOSERV ) )[0] }
sub peerservice  { my $self = shift; scalar +( $self->_get_host_service( $self->peername, 0, NIx_NOHOST ) )[1] }

=head2 peeraddr

   $addr = $peer->peeraddr

Return the peer address as a binary octet string

=cut

sub peeraddr { my $self = shift; _unpack_sockaddr $self->peername }

# This unbelievably dodgy hack works around the bug that IO::Socket doesn't do
# it
#    https://rt.cpan.org/Ticket/Display.html?id=61577
sub accept
{
   my $self = shift;
   my ( $new, $peer ) = $self->SUPER::accept( @_ ) or return;

   ${*$new}{$_} = ${*$self}{$_} for qw( io_socket_domain io_socket_type io_socket_proto );

   return wantarray ? ( $new, $peer )
                    : $new;
}

# This second unbelievably dodgy hack guarantees that $self->fileno doesn't
# change, which is useful during nonblocking connect
sub socket :method
{
   my $self = shift;
   return $self->SUPER::socket(@_) if not defined $self->fileno;

   # I hate core prototypes sometimes...
   socket( my $tmph, $_[0], $_[1], $_[2] ) or return undef;

   dup2( $tmph->fileno, $self->fileno ) or die "Unable to dup2 $tmph onto $self - $!";
}

# Versions of IO::Socket before 1.35 may leave socktype undef if from, say, an
#   ->fdopen call. In this case we'll apply a fix
BEGIN {
   if( eval($IO::Socket::VERSION) < 1.35 ) {
      *socktype = sub {
         my $self = shift;
         my $type = $self->SUPER::socktype;
         if( !defined $type ) {
            $type = $self->sockopt( Socket::SO_TYPE() );
         }
         return $type;
      };
   }
}

=head2 as_inet

   $inet = $sock->as_inet

Returns a new L<IO::Socket::INET> instance wrapping the same filehandle. This
may be useful in cases where it is required, for backward-compatibility, to
have a real object of C<IO::Socket::INET> type instead of C<IO::Socket::IP>.
The new object will wrap the same underlying socket filehandle as the
original, so care should be taken not to continue to use both objects
concurrently. Ideally the original C<$sock> should be discarded after this
method is called.

This method checks that the socket domain is C<PF_INET> and will throw an
exception if it isn't.

=cut

sub as_inet
{
   my $self = shift;
   croak "Cannot downgrade a non-PF_INET socket to IO::Socket::INET" unless $self->sockdomain == AF_INET;
   return IO::Socket::INET->new_from_fd( $self->fileno, "r+" );
}

=head1 NON-BLOCKING

If the constructor is passed a defined but false value for the C<Blocking>
argument then the socket is put into non-blocking mode. When in non-blocking
mode, the socket will not be set up by the time the constructor returns,
because the underlying C<connect(2)> syscall would otherwise have to block.

The non-blocking behaviour is an extension of the C<IO::Socket::INET> API,
unique to C<IO::Socket::IP>, because the former does not support multi-homed
non-blocking connect.

When using non-blocking mode, the caller must repeatedly check for
writeability on the filehandle (for instance using C<select> or C<IO::Poll>).
Each time the filehandle is ready to write, the C<connect> method must be
called, with no arguments. Note that some operating systems, most notably
C<MSWin32> do not report a C<connect()> failure using write-ready; so you must
also C<select()> for exceptional status.

While C<connect> returns false, the value of C<$!> indicates whether it should
be tried again (by being set to the value C<EINPROGRESS>, or C<EWOULDBLOCK> on
MSWin32), or whether a permanent error has occurred (e.g. C<ECONNREFUSED>).

Once the socket has been connected to the peer, C<connect> will return true
and the socket will now be ready to use.

Note that calls to the platform's underlying C<getaddrinfo(3)> function may
block. If C<IO::Socket::IP> has to perform this lookup, the constructor will
block even when in non-blocking mode.

To avoid this blocking behaviour, the caller should pass in the result of such
a lookup using the C<PeerAddrInfo> or C<LocalAddrInfo> arguments. This can be
achieved by using L<Net::LibAsyncNS>, or the C<getaddrinfo(3)> function can be
called in a child process.

 use IO::Socket::IP;
 use Errno qw( EINPROGRESS EWOULDBLOCK );

 my @peeraddrinfo = ... # Caller must obtain the getaddinfo result here

 my $socket = IO::Socket::IP->new(
    PeerAddrInfo => \@peeraddrinfo,
    Blocking     => 0,
 ) or die "Cannot construct socket - $@";

 while( !$socket->connect and ( $! == EINPROGRESS || $! == EWOULDBLOCK ) ) {
    my $wvec = '';
    vec( $wvec, fileno $socket, 1 ) = 1;
    my $evec = '';
    vec( $evec, fileno $socket, 1 ) = 1;

    select( undef, $wvec, $evec, undef ) or die "Cannot select - $!";
 }

 die "Cannot connect - $!" if $!;

 ...

The example above uses C<select()>, but any similar mechanism should work
analogously. C<IO::Socket::IP> takes care when creating new socket filehandles
to preserve the actual file descriptor number, so such techniques as C<poll>
or C<epoll> should be transparent to its reallocation of a different socket
underneath, perhaps in order to switch protocol family between C<PF_INET> and
C<PF_INET6>.

For another example using C<IO::Poll> and C<Net::LibAsyncNS>, see the
F<examples/nonblocking_libasyncns.pl> file in the module distribution.

=cut

=head1 C<PeerHost> AND C<LocalHost> PARSING

To support the C<IO::Socket::INET> API, the host and port information may be
passed in a single string rather than as two separate arguments.

If either C<LocalHost> or C<PeerHost> (or their C<...Addr> synonyms) have any
of the following special forms then special parsing is applied.

The value of the C<...Host> argument will be split to give both the hostname
and port (or service name):

 hostname.example.org:http    # Host name
 192.0.2.1:80                 # IPv4 address
 [2001:db8::1]:80             # IPv6 address

In each case, the port or service name (e.g. C<80>) is passed as the
C<LocalService> or C<PeerService> argument.

Either of C<LocalService> or C<PeerService> (or their C<...Port> synonyms) can
be either a service name, a decimal number, or a string containing both a
service name and number, in a form such as

 http(80)

In this case, the name (C<http>) will be tried first, but if the resolver does
not understand it then the port number (C<80>) will be used instead.

If the C<...Host> argument is in this special form and the corresponding
C<...Service> or C<...Port> argument is also defined, the one parsed from
the C<...Host> argument will take precedence and the other will be ignored.

=head2 split_addr

   ( $host, $port ) = IO::Socket::IP->split_addr( $addr )

Utility method that provides the parsing functionality described above.
Returns a 2-element list, containing either the split hostname and port
description if it could be parsed, or the given address and C<undef> if it was
not recognised.

 IO::Socket::IP->split_addr( "hostname:http" )
                              # ( "hostname",  "http" )

 IO::Socket::IP->split_addr( "192.0.2.1:80" )
                              # ( "192.0.2.1", "80"   )

 IO::Socket::IP->split_addr( "[2001:db8::1]:80" )
                              # ( "2001:db8::1", "80" )

 IO::Socket::IP->split_addr( "something.else" )
                              # ( "something.else", undef )

=cut

sub split_addr
{
   shift;
   my ( $addr ) = @_;

   local ( $1, $2 ); # Placate a taint-related bug; [perl #67962]
   if( $addr =~ m/\A\[($IPv6_re)\](?::([^\s:]*))?\z/ or
       $addr =~ m/\A([^\s:]*):([^\s:]*)\z/ ) {
      return ( $1, $2 ) if defined $2 and length $2;
      return ( $1, undef );
   }

   return ( $addr, undef );
}

=head2 join_addr

   $addr = IO::Socket::IP->join_addr( $host, $port )

Utility method that performs the reverse of C<split_addr>, returning a string
formed by joining the specified host address and port number. The host address
will be wrapped in C<[]> brackets if required (because it is a raw IPv6
numeric address).

This can be especially useful when combined with the C<sockhost_service> or
C<peerhost_service> methods.

 say "Connected to ", IO::Socket::IP->join_addr( $sock->peerhost_service );

=cut

sub join_addr
{
   shift;
   my ( $host, $port ) = @_;

   $host = "[$host]" if $host =~ m/:/;

   return join ":", $host, $port if defined $port;
   return $host;
}

# Since IO::Socket->new( Domain => ... ) will delete the Domain parameter
# before calling ->configure, we need to keep track of which it was

package # hide from indexer
   IO::Socket::IP::_ForINET;
use base qw( IO::Socket::IP );

sub configure
{
   # This is evil
   my $self = shift;
   my ( $arg ) = @_;

   bless $self, "IO::Socket::IP";
   $self->configure( { %$arg, Family => Socket::AF_INET() } );
}

package # hide from indexer
   IO::Socket::IP::_ForINET6;
use base qw( IO::Socket::IP );

sub configure
{
   # This is evil
   my $self = shift;
   my ( $arg ) = @_;

   bless $self, "IO::Socket::IP";
   $self->configure( { %$arg, Family => Socket::AF_INET6() } );
}

=head1 C<IO::Socket::INET> INCOMPATIBILITES

=over 4

=item *

The behaviour enabled by C<MultiHomed> is in fact implemented by
C<IO::Socket::IP> as it is required to correctly support searching for a
useable address from the results of the C<getaddrinfo(3)> call. The
constructor will ignore the value of this argument, except if it is defined
but false. An exception is thrown in this case, because that would request it
disable the C<getaddrinfo(3)> search behaviour in the first place.

=item *

C<IO::Socket::IP> implements both the C<Blocking> and C<Timeout> parameters,
but it implements the interaction of both in a different way.

In C<::INET>, supplying a timeout overrides the non-blocking behaviour,
meaning that the C<connect()> operation will still block despite that the
caller asked for a non-blocking socket. This is not explicitly specified in
its documentation, nor does this author believe that is a useful behaviour -
it appears to come from a quirk of implementation.

In C<::IP> therefore, the C<Blocking> parameter takes precedence - if a
non-blocking socket is requested, no operation will block. The C<Timeout>
parameter here simply defines the maximum time that a blocking C<connect()>
call will wait, if it blocks at all.

In order to specifically obtain the "blocking connect then non-blocking send
and receive" behaviour of specifying this combination of options to C<::INET>
when using C<::IP>, perform first a blocking connect, then afterwards turn the
socket into nonblocking mode.

 my $sock = IO::Socket::IP->new(
    PeerHost => $peer,
    Timeout => 20,
 ) or die "Cannot connect - $@";

 $sock->blocking( 0 );

This code will behave identically under both C<IO::Socket::INET> and
C<IO::Socket::IP>.

=back

=cut

=head1 TODO

=over 4

=item *

Investigate whether C<POSIX::dup2> upsets BSD's C<kqueue> watchers, and if so,
consider what possible workarounds might be applied.

=back

=head1 AUTHOR

Paul Evans <leonerd@leonerd.org.uk>

=cut

0x55AA;
                                                                                                                                                                                                                                                                           Compress/Zip.pm                                                                                     0000644                 00000175352 00000000000 0007415 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       package IO::Compress::Zip ;

use strict ;
use warnings;
use bytes;

use IO::Compress::Base::Common  2.101 qw(:Status );
use IO::Compress::RawDeflate 2.101 ();
use IO::Compress::Adapter::Deflate 2.101 ;
use IO::Compress::Adapter::Identity 2.101 ;
use IO::Compress::Zlib::Extra 2.101 ;
use IO::Compress::Zip::Constants 2.101 ;

use File::Spec();
use Config;

use Compress::Raw::Zlib  2.101 ();

BEGIN
{
    eval { require IO::Compress::Adapter::Bzip2 ;
           IO::Compress::Adapter::Bzip2->import( 2.101 );
           require IO::Compress::Bzip2 ;
           IO::Compress::Bzip2->import( 2.101 );
         } ;

    eval { require IO::Compress::Adapter::Lzma ;
           IO::Compress::Adapter::Lzma->import( 2.101 );
           require IO::Compress::Lzma ;
           IO::Compress::Lzma->import( 2.101 );
         } ;

    eval { require IO::Compress::Adapter::Xz ;
           IO::Compress::Adapter::Xz->import( 2.101 );
           require IO::Compress::Xz ;
           IO::Compress::Xz->import( 2.101 );
         } ;
    eval { require IO::Compress::Adapter::Zstd ;
           IO::Compress::Adapter::Zstd->import( 2.101 );
           require IO::Compress::Zstd ;
           IO::Compress::Zstd->import( 2.101 );
         } ;
}


require Exporter ;

our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $ZipError);

$VERSION = '2.102';
$ZipError = '';

@ISA = qw(IO::Compress::RawDeflate Exporter);
@EXPORT_OK = qw( $ZipError zip ) ;
%EXPORT_TAGS = %IO::Compress::RawDeflate::DEFLATE_CONSTANTS ;

push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;

$EXPORT_TAGS{zip_method} = [qw( ZIP_CM_STORE ZIP_CM_DEFLATE ZIP_CM_BZIP2 ZIP_CM_LZMA ZIP_CM_XZ ZIP_CM_ZSTD)];
push @{ $EXPORT_TAGS{all} }, @{ $EXPORT_TAGS{zip_method} };

Exporter::export_ok_tags('all');

sub new
{
    my $class = shift ;

    my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$ZipError);
    $obj->_create(undef, @_);

}

sub zip
{
    my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$ZipError);
    return $obj->_def(@_);
}

sub isMethodAvailable
{
    my $method = shift;

    # Store & Deflate are always available
    return 1
        if $method == ZIP_CM_STORE || $method == ZIP_CM_DEFLATE ;

    return 1
        if $method == ZIP_CM_BZIP2 and
           defined $IO::Compress::Adapter::Bzip2::VERSION;

    return 1
        if $method == ZIP_CM_LZMA and
           defined $IO::Compress::Adapter::Lzma::VERSION;

    return 1
        if $method == ZIP_CM_XZ and
           defined $IO::Compress::Adapter::Xz::VERSION;

    return 1
        if $method == ZIP_CM_ZSTD and
           defined $IO::Compress::Adapter::ZSTD::VERSION;

    return 0;
}

sub beforePayload
{
    my $self = shift ;

    if (*$self->{ZipData}{Sparse} ) {
        my $inc = 1024 * 100 ;
        my $NULLS = ("\x00" x $inc) ;
        my $sparse = *$self->{ZipData}{Sparse} ;
        *$self->{CompSize}->add( $sparse );
        *$self->{UnCompSize}->add( $sparse );

        *$self->{FH}->seek($sparse, IO::Handle::SEEK_CUR);

        *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32($NULLS, *$self->{ZipData}{CRC32})
            for 1 .. int $sparse / $inc;
        *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(substr($NULLS, 0,  $sparse % $inc),
                                         *$self->{ZipData}{CRC32})
            if $sparse % $inc;
    }
}

sub mkComp
{
    my $self = shift ;
    my $got = shift ;

    my ($obj, $errstr, $errno) ;

    if (*$self->{ZipData}{Method} == ZIP_CM_STORE) {
        ($obj, $errstr, $errno) = IO::Compress::Adapter::Identity::mkCompObject(
                                                 $got->getValue('level'),
                                                 $got->getValue('strategy')
                                                 );
        *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef);
    }
    elsif (*$self->{ZipData}{Method} == ZIP_CM_DEFLATE) {
        ($obj, $errstr, $errno) = IO::Compress::Adapter::Deflate::mkCompObject(
                                                 $got->getValue('crc32'),
                                                 $got->getValue('adler32'),
                                                 $got->getValue('level'),
                                                 $got->getValue('strategy')
                                                 );
    }
    elsif (*$self->{ZipData}{Method} == ZIP_CM_BZIP2) {
        ($obj, $errstr, $errno) = IO::Compress::Adapter::Bzip2::mkCompObject(
                                                $got->getValue('blocksize100k'),
                                                $got->getValue('workfactor'),
                                                $got->getValue('verbosity')
                                               );
        *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef);
    }
    elsif (*$self->{ZipData}{Method} == ZIP_CM_LZMA) {
        ($obj, $errstr, $errno) = IO::Compress::Adapter::Lzma::mkRawZipCompObject($got->getValue('preset'),
                                                                                 $got->getValue('extreme'),
                                                                                 );
        *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef);
    }
    elsif (*$self->{ZipData}{Method} == ZIP_CM_XZ) {
        ($obj, $errstr, $errno) = IO::Compress::Adapter::Xz::mkCompObject($got->getValue('preset'),
                                                                                 $got->getValue('extreme'),
                                                                                 0
                                                                                 );
        *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef);
    }
    elsif (*$self->{ZipData}{Method} == ZIP_CM_ZSTD) {
        ($obj, $errstr, $errno) = IO::Compress::Adapter::Zstd::mkCompObject(defined $got->getValue('level') ? $got->getValue('level') : 3,
                                                                           );
        *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef);
    }

    return $self->saveErrorString(undef, $errstr, $errno)
       if ! defined $obj;

    if (! defined *$self->{ZipData}{SizesOffset}) {
        *$self->{ZipData}{SizesOffset} = 0;
        *$self->{ZipData}{Offset} = U64->new();
    }

    *$self->{ZipData}{AnyZip64} = 0
        if ! defined  *$self->{ZipData}{AnyZip64} ;

    return $obj;
}

sub reset
{
    my $self = shift ;

    *$self->{Compress}->reset();
    *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32('');

    return STATUS_OK;
}

sub filterUncompressed
{
    my $self = shift ;

    if (*$self->{ZipData}{Method} == ZIP_CM_DEFLATE) {
        *$self->{ZipData}{CRC32} = *$self->{Compress}->crc32();
    }
    else {
        *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(${$_[0]}, *$self->{ZipData}{CRC32});

    }
}

sub canonicalName
{
    # This sub is derived from Archive::Zip::_asZipDirName

    # Return the normalized name as used in a zip file (path
    # separators become slashes, etc.).
    # Will translate internal slashes in path components (i.e. on Macs) to
    # underscores.  Discards volume names.
    # When $forceDir is set, returns paths with trailing slashes
    #
    # input         output
    # .             '.'
    # ./a           a
    # ./a/b         a/b
    # ./a/b/        a/b
    # a/b/          a/b
    # /a/b/         a/b
    # c:\a\b\c.doc  a/b/c.doc      # on Windows
    # "i/o maps:whatever"   i_o maps/whatever   # on Macs

    my $name      = shift;
    my $forceDir  = shift ;

    my ( $volume, $directories, $file ) =
      File::Spec->splitpath( File::Spec->canonpath($name), $forceDir );

    my @dirs = map { $_ =~ s{/}{_}g; $_ }
               File::Spec->splitdir($directories);

    if ( @dirs > 0 ) { pop (@dirs) if $dirs[-1] eq '' }   # remove empty component
    push @dirs, defined($file) ? $file : '' ;

    my $normalised_path = join '/', @dirs;

    # Leading directory separators should not be stored in zip archives.
    # Example:
    #   C:\a\b\c\      a/b/c
    #   C:\a\b\c.txt   a/b/c.txt
    #   /a/b/c/        a/b/c
    #   /a/b/c.txt     a/b/c.txt
    $normalised_path =~ s{^/}{};  # remove leading separator

    return $normalised_path;
}


sub mkHeader
{
    my $self  = shift;
    my $param = shift ;

    *$self->{ZipData}{LocalHdrOffset} = U64::clone(*$self->{ZipData}{Offset});

    my $comment = '';
    $comment = $param->valueOrDefault('comment') ;

    my $filename = '';
    $filename = $param->valueOrDefault('name') ;

    $filename = canonicalName($filename)
        if length $filename && $param->getValue('canonicalname') ;

    if (defined *$self->{ZipData}{FilterName} ) {
        local *_ = \$filename ;
        &{ *$self->{ZipData}{FilterName} }() ;
    }

   if ( $param->getValue('efs') && $] >= 5.008004) {
        if (length $filename) {
            utf8::downgrade($filename, 1)
                or Carp::croak "Wide character in zip filename";
        }

        if (length $comment) {
            utf8::downgrade($comment, 1)
                or Carp::croak "Wide character in zip comment";
        }
   }

    my $hdr = '';

    my $time = _unixToDosTime($param->getValue('time'));

    my $extra = '';
    my $ctlExtra = '';
    my $empty = 0;
    my $osCode = $param->getValue('os_code') ;
    my $extFileAttr = 0 ;

    # This code assumes Unix.
    # TODO - revisit this
    $extFileAttr = 0100644 << 16
        if $osCode == ZIP_OS_CODE_UNIX ;

    if (*$self->{ZipData}{Zip64}) {
        $empty = IO::Compress::Base::Common::MAX32;

        my $x = '';
        $x .= pack "V V", 0, 0 ; # uncompressedLength
        $x .= pack "V V", 0, 0 ; # compressedLength

        # Zip64 needs to be first in extra field to workaround a Windows Explorer Bug
        # See http://www.info-zip.org/phpBB3/viewtopic.php?f=3&t=440 for details
        $extra .= IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_ZIP64, $x);
    }

    if (! $param->getValue('minimal')) {
        if ($param->parsed('mtime'))
        {
            $extra .= mkExtendedTime($param->getValue('mtime'),
                                    $param->getValue('atime'),
                                    $param->getValue('ctime'));

            $ctlExtra .= mkExtendedTime($param->getValue('mtime'));
        }

        if ( $osCode == ZIP_OS_CODE_UNIX )
        {
            if ( $param->getValue('want_exunixn') )
            {
                    my $ux3 = mkUnixNExtra( @{ $param->getValue('want_exunixn') });
                    $extra    .= $ux3;
                    $ctlExtra .= $ux3;
            }

            if ( $param->getValue('exunix2') )
            {
                    $extra    .= mkUnix2Extra( @{ $param->getValue('exunix2') });
                    $ctlExtra .= mkUnix2Extra();
            }
        }

        $extFileAttr = $param->getValue('extattr')
            if defined $param->getValue('extattr') ;

        $extra .= $param->getValue('extrafieldlocal')
            if defined $param->getValue('extrafieldlocal');

        $ctlExtra .= $param->getValue('extrafieldcentral')
            if defined $param->getValue('extrafieldcentral');
    }

    my $method = *$self->{ZipData}{Method} ;
    my $gpFlag = 0 ;
    $gpFlag |= ZIP_GP_FLAG_STREAMING_MASK
        if *$self->{ZipData}{Stream} ;

    $gpFlag |= ZIP_GP_FLAG_LZMA_EOS_PRESENT
        if $method == ZIP_CM_LZMA ;

    $gpFlag |= ZIP_GP_FLAG_LANGUAGE_ENCODING
        if  $param->getValue('efs') && (length($filename) || length($comment));

    my $version = $ZIP_CM_MIN_VERSIONS{$method};
    $version = ZIP64_MIN_VERSION
        if ZIP64_MIN_VERSION > $version && *$self->{ZipData}{Zip64};

    my $madeBy = ($param->getValue('os_code') << 8) + $version;
    my $extract = $version;

    *$self->{ZipData}{Version} = $version;
    *$self->{ZipData}{MadeBy} = $madeBy;

    my $ifa = 0;
    $ifa |= ZIP_IFA_TEXT_MASK
        if $param->getValue('textflag');

    $hdr .= pack "V", ZIP_LOCAL_HDR_SIG ; # signature
    $hdr .= pack 'v', $extract   ; # extract Version & OS
    $hdr .= pack 'v', $gpFlag    ; # general purpose flag (set streaming mode)
    $hdr .= pack 'v', $method    ; # compression method (deflate)
    $hdr .= pack 'V', $time      ; # last mod date/time
    $hdr .= pack 'V', 0          ; # crc32               - 0 when streaming
    $hdr .= pack 'V', $empty     ; # compressed length   - 0 when streaming
    $hdr .= pack 'V', $empty     ; # uncompressed length - 0 when streaming
    $hdr .= pack 'v', length $filename ; # filename length
    $hdr .= pack 'v', length $extra ; # extra length

    $hdr .= $filename ;

    # Remember the offset for the compressed & uncompressed lengths in the
    # local header.
    if (*$self->{ZipData}{Zip64}) {
        *$self->{ZipData}{SizesOffset} = *$self->{ZipData}{Offset}->get64bit()
            + length($hdr) + 4 ;
    }
    else {
        *$self->{ZipData}{SizesOffset} = *$self->{ZipData}{Offset}->get64bit()
                                            + 18;
    }

    $hdr .= $extra ;


    my $ctl = '';

    $ctl .= pack "V", ZIP_CENTRAL_HDR_SIG ; # signature
    $ctl .= pack 'v', $madeBy    ; # version made by
    $ctl .= pack 'v', $extract   ; # extract Version
    $ctl .= pack 'v', $gpFlag    ; # general purpose flag (streaming mode)
    $ctl .= pack 'v', $method    ; # compression method (deflate)
    $ctl .= pack 'V', $time      ; # last mod date/time
    $ctl .= pack 'V', 0          ; # crc32
    $ctl .= pack 'V', $empty     ; # compressed length
    $ctl .= pack 'V', $empty     ; # uncompressed length
    $ctl .= pack 'v', length $filename ; # filename length

    *$self->{ZipData}{ExtraOffset} = length $ctl;
    *$self->{ZipData}{ExtraSize} = length $ctlExtra ;

    $ctl .= pack 'v', length $ctlExtra ; # extra length
    $ctl .= pack 'v', length $comment ;  # file comment length
    $ctl .= pack 'v', 0          ; # disk number start
    $ctl .= pack 'v', $ifa       ; # internal file attributes
    $ctl .= pack 'V', $extFileAttr   ; # external file attributes

    # offset to local hdr
    if (*$self->{ZipData}{LocalHdrOffset}->is64bit() ) {
        $ctl .= pack 'V', IO::Compress::Base::Common::MAX32 ;
    }
    else {
        $ctl .= *$self->{ZipData}{LocalHdrOffset}->getPacked_V32() ;
    }

    $ctl .= $filename ;

    *$self->{ZipData}{Offset}->add32(length $hdr) ;

    *$self->{ZipData}{CentralHeader} = [ $ctl, $ctlExtra, $comment];

    return $hdr;
}

sub mkTrailer
{
    my $self = shift ;

    my $crc32 ;
    if (*$self->{ZipData}{Method} == ZIP_CM_DEFLATE) {
        $crc32 = pack "V", *$self->{Compress}->crc32();
    }
    else {
        $crc32 = pack "V", *$self->{ZipData}{CRC32};
    }

    my ($ctl, $ctlExtra, $comment) = @{ *$self->{ZipData}{CentralHeader} };

    my $sizes ;
    if (! *$self->{ZipData}{Zip64}) {
        $sizes .= *$self->{CompSize}->getPacked_V32() ;   # Compressed size
        $sizes .= *$self->{UnCompSize}->getPacked_V32() ; # Uncompressed size
    }
    else {
        $sizes .= *$self->{CompSize}->getPacked_V64() ;   # Compressed size
        $sizes .= *$self->{UnCompSize}->getPacked_V64() ; # Uncompressed size
    }

    my $data = $crc32 . $sizes ;

    my $xtrasize  = *$self->{UnCompSize}->getPacked_V64() ; # Uncompressed size
       $xtrasize .= *$self->{CompSize}->getPacked_V64() ;   # Compressed size

    my $hdr = '';

    if (*$self->{ZipData}{Stream}) {
        $hdr  = pack "V", ZIP_DATA_HDR_SIG ;                       # signature
        $hdr .= $data ;
    }
    else {
        $self->writeAt(*$self->{ZipData}{LocalHdrOffset}->get64bit() + 14,  $crc32)
            or return undef;
        $self->writeAt(*$self->{ZipData}{SizesOffset},
                *$self->{ZipData}{Zip64} ? $xtrasize : $sizes)
            or return undef;
    }

    # Central Header Record/Zip64 extended field

    substr($ctl, 16, length $crc32) = $crc32 ;

    my $zip64Payload = '';

    # uncompressed length - only set zip64 if needed
    if (*$self->{UnCompSize}->isAlmost64bit()) { #  || *$self->{ZipData}{Zip64}) {
        $zip64Payload .= *$self->{UnCompSize}->getPacked_V64() ;
    } else {
        substr($ctl, 24, 4) = *$self->{UnCompSize}->getPacked_V32() ;
    }

    # compressed length - only set zip64 if needed
    if (*$self->{CompSize}->isAlmost64bit()) { # || *$self->{ZipData}{Zip64}) {
        $zip64Payload .= *$self->{CompSize}->getPacked_V64() ;
    } else {
        substr($ctl, 20, 4) = *$self->{CompSize}->getPacked_V32() ;
    }

    # Local Header offset
    $zip64Payload .= *$self->{ZipData}{LocalHdrOffset}->getPacked_V64()
        if *$self->{ZipData}{LocalHdrOffset}->is64bit() ;

    # disk no - always zero, so don't need to include it.
    #$zip64Payload .= pack "V", 0    ;

    my $zip64Xtra = '';

    if (length $zip64Payload) {
        $zip64Xtra = IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_ZIP64, $zip64Payload);

        substr($ctl, *$self->{ZipData}{ExtraOffset}, 2) =
             pack 'v', *$self->{ZipData}{ExtraSize} + length $zip64Xtra;

        *$self->{ZipData}{AnyZip64} = 1;
    }

    # Zip64 needs to be first in extra field to workaround a Windows Explorer Bug
    # See http://www.info-zip.org/phpBB3/viewtopic.php?f=3&t=440 for details
    $ctl .= $zip64Xtra . $ctlExtra . $comment;

    *$self->{ZipData}{Offset}->add32(length($hdr));
    *$self->{ZipData}{Offset}->add( *$self->{CompSize} );
    push @{ *$self->{ZipData}{CentralDir} }, $ctl ;

    return $hdr;
}

sub mkFinalTrailer
{
    my $self = shift ;

    my $comment = '';
    $comment = *$self->{ZipData}{ZipComment} ;

    my $cd_offset = *$self->{ZipData}{Offset}->get32bit() ; # offset to start central dir

    my $entries = @{ *$self->{ZipData}{CentralDir} };

    *$self->{ZipData}{AnyZip64} = 1
        if *$self->{ZipData}{Offset}->is64bit || $entries >= 0xFFFF ;

    my $cd = join '', @{ *$self->{ZipData}{CentralDir} };
    my $cd_len = length $cd ;

    my $z64e = '';

    if ( *$self->{ZipData}{AnyZip64} ) {

        my $v  = *$self->{ZipData}{Version} ;
        my $mb = *$self->{ZipData}{MadeBy} ;
        $z64e .= pack 'v', $mb            ; # Version made by
        $z64e .= pack 'v', $v             ; # Version to extract
        $z64e .= pack 'V', 0              ; # number of disk
        $z64e .= pack 'V', 0              ; # number of disk with central dir
        $z64e .= U64::pack_V64 $entries   ; # entries in central dir on this disk
        $z64e .= U64::pack_V64 $entries   ; # entries in central dir
        $z64e .= U64::pack_V64 $cd_len    ; # size of central dir
        $z64e .= *$self->{ZipData}{Offset}->getPacked_V64() ; # offset to start central dir

        $z64e  = pack("V", ZIP64_END_CENTRAL_REC_HDR_SIG) # signature
              .  U64::pack_V64(length $z64e)
              .  $z64e ;

        *$self->{ZipData}{Offset}->add32(length $cd) ;

        $z64e .= pack "V", ZIP64_END_CENTRAL_LOC_HDR_SIG; # signature
        $z64e .= pack 'V', 0              ; # number of disk with central dir
        $z64e .= *$self->{ZipData}{Offset}->getPacked_V64() ; # offset to end zip64 central dir
        $z64e .= pack 'V', 1              ; # Total number of disks

        $cd_offset = IO::Compress::Base::Common::MAX32 ;
        $cd_len = IO::Compress::Base::Common::MAX32 if IO::Compress::Base::Common::isGeMax32 $cd_len ;
        $entries = 0xFFFF if $entries >= 0xFFFF ;
    }

    my $ecd = '';
    $ecd .= pack "V", ZIP_END_CENTRAL_HDR_SIG ; # signature
    $ecd .= pack 'v', 0          ; # number of disk
    $ecd .= pack 'v', 0          ; # number of disk with central dir
    $ecd .= pack 'v', $entries   ; # entries in central dir on this disk
    $ecd .= pack 'v', $entries   ; # entries in central dir
    $ecd .= pack 'V', $cd_len    ; # size of central dir
    $ecd .= pack 'V', $cd_offset ; # offset to start central dir
    $ecd .= pack 'v', length $comment ; # zipfile comment length
    $ecd .= $comment;

    return $cd . $z64e . $ecd ;
}

sub ckParams
{
    my $self = shift ;
    my $got = shift;

    $got->setValue('crc32' => 1);

    if (! $got->parsed('time') ) {
        # Modification time defaults to now.
        $got->setValue('time' => time) ;
    }

    if ($got->parsed('extime') ) {
        my $timeRef = $got->getValue('extime');
        if ( defined $timeRef) {
            return $self->saveErrorString(undef, "exTime not a 3-element array ref")
                if ref $timeRef ne 'ARRAY' || @$timeRef != 3;
        }

        $got->setValue("mtime", $timeRef->[1]);
        $got->setValue("atime", $timeRef->[0]);
        $got->setValue("ctime", $timeRef->[2]);
    }

    # Unix2/3 Extended Attribute
    for my $name (qw(exunix2 exunixn))
    {
        if ($got->parsed($name) ) {
            my $idRef = $got->getValue($name);
            if ( defined $idRef) {
                return $self->saveErrorString(undef, "$name not a 2-element array ref")
                    if ref $idRef ne 'ARRAY' || @$idRef != 2;
            }

            $got->setValue("uid", $idRef->[0]);
            $got->setValue("gid", $idRef->[1]);
            $got->setValue("want_$name", $idRef);
        }
    }

    *$self->{ZipData}{AnyZip64} = 1
        if $got->getValue('zip64');
    *$self->{ZipData}{Zip64} = $got->getValue('zip64');
    *$self->{ZipData}{Stream} = $got->getValue('stream');

    my $method = $got->getValue('method');
    return $self->saveErrorString(undef, "Unknown Method '$method'")
        if ! defined $ZIP_CM_MIN_VERSIONS{$method};

    return $self->saveErrorString(undef, "Bzip2 not available")
        if $method == ZIP_CM_BZIP2 and
           ! defined $IO::Compress::Adapter::Bzip2::VERSION;

    return $self->saveErrorString(undef, "Lzma not available")
        if $method == ZIP_CM_LZMA
        and ! defined $IO::Compress::Adapter::Lzma::VERSION;

    *$self->{ZipData}{Method} = $method;

    *$self->{ZipData}{ZipComment} = $got->getValue('zipcomment') ;

    for my $name (qw( extrafieldlocal extrafieldcentral ))
    {
        my $data = $got->getValue($name) ;
        if (defined $data) {
            my $bad = IO::Compress::Zlib::Extra::parseExtraField($data, 1, 0) ;
            return $self->saveErrorString(undef, "Error with $name Parameter: $bad")
                if $bad ;

            $got->setValue($name, $data) ;
        }
    }

    return undef
        if defined $IO::Compress::Bzip2::VERSION
            and ! IO::Compress::Bzip2::ckParams($self, $got);

    if ($got->parsed('sparse') ) {
        *$self->{ZipData}{Sparse} = $got->getValue('sparse') ;
        *$self->{ZipData}{Method} = ZIP_CM_STORE;
    }

    if ($got->parsed('filtername')) {
        my $v = $got->getValue('filtername') ;
        *$self->{ZipData}{FilterName} = $v
            if ref $v eq 'CODE' ;
    }

    return 1 ;
}

sub outputPayload
{
    my $self = shift ;
    return 1 if *$self->{ZipData}{Sparse} ;
    return $self->output(@_);
}


#sub newHeader
#{
#    my $self = shift ;
#
#    return $self->mkHeader(*$self->{Got});
#}


our %PARAMS = (
            'stream'    => [IO::Compress::Base::Common::Parse_boolean,   1],
           #'store'     => [IO::Compress::Base::Common::Parse_boolean,   0],
            'method'    => [IO::Compress::Base::Common::Parse_unsigned,  ZIP_CM_DEFLATE],

#            # Zip header fields
            'minimal'   => [IO::Compress::Base::Common::Parse_boolean,   0],
            'zip64'     => [IO::Compress::Base::Common::Parse_boolean,   0],
            'comment'   => [IO::Compress::Base::Common::Parse_any,       ''],
            'zipcomment'=> [IO::Compress::Base::Common::Parse_any,       ''],
            'name'      => [IO::Compress::Base::Common::Parse_any,       ''],
            'filtername'=> [IO::Compress::Base::Common::Parse_code,      undef],
            'canonicalname'=> [IO::Compress::Base::Common::Parse_boolean,   0],
            'efs'       => [IO::Compress::Base::Common::Parse_boolean,   0],
            'time'      => [IO::Compress::Base::Common::Parse_any,       undef],
            'extime'    => [IO::Compress::Base::Common::Parse_any,       undef],
            'exunix2'   => [IO::Compress::Base::Common::Parse_any,       undef],
            'exunixn'   => [IO::Compress::Base::Common::Parse_any,       undef],
            'extattr'   => [IO::Compress::Base::Common::Parse_any,
                    $Compress::Raw::Zlib::gzip_os_code == 3
                        ? 0100644 << 16
                        : 0],
            'os_code'   => [IO::Compress::Base::Common::Parse_unsigned,  $Compress::Raw::Zlib::gzip_os_code],

            'textflag'  => [IO::Compress::Base::Common::Parse_boolean,   0],
            'extrafieldlocal'  => [IO::Compress::Base::Common::Parse_any,    undef],
            'extrafieldcentral'=> [IO::Compress::Base::Common::Parse_any,    undef],

            # Lzma
            'preset'   => [IO::Compress::Base::Common::Parse_unsigned, 6],
            'extreme'  => [IO::Compress::Base::Common::Parse_boolean,  0],

            # For internal use only
            'sparse'    => [IO::Compress::Base::Common::Parse_unsigned,  0],

            IO::Compress::RawDeflate::getZlibParams(),
            defined $IO::Compress::Bzip2::VERSION
                ? IO::Compress::Bzip2::getExtraParams()
                : ()


                );

sub getExtraParams
{
    return %PARAMS ;
}

sub getInverseClass
{
    no warnings 'once';
    return ('IO::Uncompress::Unzip',
                \$IO::Uncompress::Unzip::UnzipError);
}

sub getFileInfo
{
    my $self = shift ;
    my $params = shift;
    my $filename = shift ;

    if (IO::Compress::Base::Common::isaScalar($filename))
    {
        $params->setValue(zip64 => 1)
            if IO::Compress::Base::Common::isGeMax32 length (${ $filename }) ;

        return ;
    }

    my ($mode, $uid, $gid, $size, $atime, $mtime, $ctime) ;
    if ( $params->parsed('storelinks') )
    {
        ($mode, $uid, $gid, $size, $atime, $mtime, $ctime)
                = (lstat($filename))[2, 4,5,7, 8,9,10] ;
    }
    else
    {
        ($mode, $uid, $gid, $size, $atime, $mtime, $ctime)
                = (stat($filename))[2, 4,5,7, 8,9,10] ;
    }

    $params->setValue(textflag => -T $filename )
        if ! $params->parsed('textflag');

    $params->setValue(zip64 => 1)
        if IO::Compress::Base::Common::isGeMax32 $size ;

    $params->setValue('name' => $filename)
        if ! $params->parsed('name') ;

    $params->setValue('time' => $mtime)
        if ! $params->parsed('time') ;

    if ( ! $params->parsed('extime'))
    {
        $params->setValue('mtime' => $mtime) ;
        $params->setValue('atime' => $atime) ;
        $params->setValue('ctime' => undef) ; # No Creation time
        # TODO - see if can fillout creation time on non-Unix
    }

    # NOTE - Unix specific code alert
    if (! $params->parsed('extattr'))
    {
        use Fcntl qw(:mode) ;
        my $attr = $mode << 16;
        $attr |= ZIP_A_RONLY if ($mode & S_IWRITE) == 0 ;
        $attr |= ZIP_A_DIR   if ($mode & S_IFMT  ) == S_IFDIR ;

        $params->setValue('extattr' => $attr);
    }

    $params->setValue('want_exunixn', [$uid, $gid]);
    $params->setValue('uid' => $uid) ;
    $params->setValue('gid' => $gid) ;

}

sub mkExtendedTime
{
    # order expected is m, a, c

    my $times = '';
    my $bit = 1 ;
    my $flags = 0;

    for my $time (@_)
    {
        if (defined $time)
        {
            $flags |= $bit;
            $times .= pack("V", $time);
        }

        $bit <<= 1 ;
    }

    return IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_EXT_TIMESTAMP,
                                                 pack("C", $flags) .  $times);
}

sub mkUnix2Extra
{
    my $ids = '';
    for my $id (@_)
    {
        $ids .= pack("v", $id);
    }

    return IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_INFO_ZIP_UNIX2,
                                                 $ids);
}

sub mkUnixNExtra
{
    my $uid = shift;
    my $gid = shift;

    # Assumes UID/GID are 32-bit
    my $ids ;
    $ids .= pack "C", 1; # version
    $ids .= pack "C", $Config{uidsize};
    $ids .= pack "V", $uid;
    $ids .= pack "C", $Config{gidsize};
    $ids .= pack "V", $gid;

    return IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_INFO_ZIP_UNIXN,
                                                 $ids);
}


# from Archive::Zip
sub _unixToDosTime    # Archive::Zip::Member
{
	my $time_t = shift;

    # TODO - add something to cope with unix time < 1980
	my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime($time_t);
	my $dt = 0;
	$dt += ( $sec >> 1 );
	$dt += ( $min << 5 );
	$dt += ( $hour << 11 );
	$dt += ( $mday << 16 );
	$dt += ( ( $mon + 1 ) << 21 );
	$dt += ( ( $year - 80 ) << 25 );
	return $dt;
}

1;

__END__

=head1 NAME

IO::Compress::Zip - Write zip files/buffers

=head1 SYNOPSIS

    use IO::Compress::Zip qw(zip $ZipError) ;

    my $status = zip $input => $output [,OPTS]
        or die "zip failed: $ZipError\n";

    my $z = IO::Compress::Zip->new( $output [,OPTS] )
        or die "zip failed: $ZipError\n";

    $z->print($string);
    $z->printf($format, $string);
    $z->write($string);
    $z->syswrite($string [, $length, $offset]);
    $z->flush();
    $z->tell();
    $z->eof();
    $z->seek($position, $whence);
    $z->binmode();
    $z->fileno();
    $z->opened();
    $z->autoflush();
    $z->input_line_number();
    $z->newStream( [OPTS] );

    $z->deflateParams();

    $z->close() ;

    $ZipError ;

    # IO::File mode

    print $z $string;
    printf $z $format, $string;
    tell $z
    eof $z
    seek $z, $position, $whence
    binmode $z
    fileno $z
    close $z ;

=head1 DESCRIPTION

This module provides a Perl interface that allows writing zip
compressed data to files or buffer.

The primary purpose of this module is to provide streaming write access to
zip files and buffers.

At present the following compression methods are supported by IO::Compress::Zip

=over 5

=item Store (0)

=item Deflate (8)

=item Bzip2 (12)

To write Bzip2 content, the module C<IO::Uncompress::Bunzip2> must
be installed.

=item Lzma (14)

To write LZMA content, the module C<IO::Uncompress::UnLzma> must
be installed.

=item Zstandard (93)

To write Zstandard content, the module C<IO::Compress::Zstd> must
be installed.

=item Xz (95)

To write Xz content, the module C<IO::Uncompress::UnXz> must
be installed.

=back

For reading zip files/buffers, see the companion module
L<IO::Uncompress::Unzip|IO::Uncompress::Unzip>.

=head1 Functional Interface

A top-level function, C<zip>, is provided to carry out
"one-shot" compression between buffers and/or files. For finer
control over the compression process, see the L</"OO Interface">
section.

    use IO::Compress::Zip qw(zip $ZipError) ;

    zip $input_filename_or_reference => $output_filename_or_reference [,OPTS]
        or die "zip failed: $ZipError\n";

The functional interface needs Perl5.005 or better.

=head2 zip $input_filename_or_reference => $output_filename_or_reference [, OPTS]

C<zip> expects at least two parameters,
C<$input_filename_or_reference> and C<$output_filename_or_reference>
and zero or more optional parameters (see L</Optional Parameters>)

=head3 The C<$input_filename_or_reference> parameter

The parameter, C<$input_filename_or_reference>, is used to define the
source of the uncompressed data.

It can take one of the following forms:

=over 5

=item A filename

If the C<$input_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename. This file will be opened for reading and the
input data will be read from it.

=item A filehandle

If the C<$input_filename_or_reference> parameter is a filehandle, the input
data will be read from it.  The string '-' can be used as an alias for
standard input.

=item A scalar reference

If C<$input_filename_or_reference> is a scalar reference, the input data
will be read from C<$$input_filename_or_reference>.

=item An array reference

If C<$input_filename_or_reference> is an array reference, each element in
the array must be a filename.

The input data will be read from each file in turn.

The complete array will be walked to ensure that it only
contains valid filenames before any data is compressed.

=item An Input FileGlob string

If C<$input_filename_or_reference> is a string that is delimited by the
characters "<" and ">" C<zip> will assume that it is an
I<input fileglob string>. The input is the list of files that match the
fileglob.

See L<File::GlobMapper|File::GlobMapper> for more details.

=back

If the C<$input_filename_or_reference> parameter is any other type,
C<undef> will be returned.

In addition, if C<$input_filename_or_reference> is a simple filename,
the default values for
the C<Name>, C<Time>, C<TextFlag>, C<ExtAttr>, C<exUnixN> and C<exTime> options will be sourced from that file.

If you do not want to use these defaults they can be overridden by
explicitly setting the C<Name>, C<Time>, C<TextFlag>, C<ExtAttr>, C<exUnixN> and C<exTime> options or by setting the
C<Minimal> parameter.

=head3 The C<$output_filename_or_reference> parameter

The parameter C<$output_filename_or_reference> is used to control the
destination of the compressed data. This parameter can take one of
these forms.

=over 5

=item A filename

If the C<$output_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename.  This file will be opened for writing and the
compressed data will be written to it.

=item A filehandle

If the C<$output_filename_or_reference> parameter is a filehandle, the
compressed data will be written to it.  The string '-' can be used as
an alias for standard output.

=item A scalar reference

If C<$output_filename_or_reference> is a scalar reference, the
compressed data will be stored in C<$$output_filename_or_reference>.

=item An Array Reference

If C<$output_filename_or_reference> is an array reference,
the compressed data will be pushed onto the array.

=item An Output FileGlob

If C<$output_filename_or_reference> is a string that is delimited by the
characters "<" and ">" C<zip> will assume that it is an
I<output fileglob string>. The output is the list of files that match the
fileglob.

When C<$output_filename_or_reference> is an fileglob string,
C<$input_filename_or_reference> must also be a fileglob string. Anything
else is an error.

See L<File::GlobMapper|File::GlobMapper> for more details.

=back

If the C<$output_filename_or_reference> parameter is any other type,
C<undef> will be returned.

=head2 Notes

When C<$input_filename_or_reference> maps to multiple files/buffers and
C<$output_filename_or_reference> is a single
file/buffer the input files/buffers will each be stored
in C<$output_filename_or_reference> as a distinct entry.

=head2 Optional Parameters

The optional parameters for the one-shot function C<zip>
are (for the most part) identical to those used with the OO interface defined in the
L</"Constructor Options"> section. The exceptions are listed below

=over 5

=item C<< AutoClose => 0|1 >>

This option applies to any input or output data streams to
C<zip> that are filehandles.

If C<AutoClose> is specified, and the value is true, it will result in all
input and/or output filehandles being closed once C<zip> has
completed.

This parameter defaults to 0.

=item C<< BinModeIn => 0|1 >>

This option is now a no-op. All files will be read in binmode.

=item C<< Append => 0|1 >>

The behaviour of this option is dependent on the type of output data
stream.

=over 5

=item * A Buffer

If C<Append> is enabled, all compressed data will be append to the end of
the output buffer. Otherwise the output buffer will be cleared before any
compressed data is written to it.

=item * A Filename

If C<Append> is enabled, the file will be opened in append mode. Otherwise
the contents of the file, if any, will be truncated before any compressed
data is written to it.

=item * A Filehandle

If C<Append> is enabled, the filehandle will be positioned to the end of
the file via a call to C<seek> before any compressed data is
written to it.  Otherwise the file pointer will not be moved.

=back

When C<Append> is specified, and set to true, it will I<append> all compressed
data to the output data stream.

So when the output is a filehandle it will carry out a seek to the eof
before writing any compressed data. If the output is a filename, it will be opened for
appending. If the output is a buffer, all compressed data will be
appended to the existing buffer.

Conversely when C<Append> is not specified, or it is present and is set to
false, it will operate as follows.

When the output is a filename, it will truncate the contents of the file
before writing any compressed data. If the output is a filehandle
its position will not be changed. If the output is a buffer, it will be
wiped before any compressed data is output.

Defaults to 0.

=back

=head2 Examples

Here are a few example that show the capabilities of the module.

=head3 Streaming

This very simple command line example demonstrates the streaming capabilities of the module.
The code reads data from STDIN, compresses it, and writes the compressed data to STDOUT.

    $ echo hello world | perl -MIO::Compress::Zip=zip -e 'zip \*STDIN => \*STDOUT' >output.zip

The special filename "-" can be used as a standin for both C<\*STDIN> and C<\*STDOUT>,
so the above can be rewritten as

    $ echo hello world | perl -MIO::Compress::Zip=zip -e 'zip "-" => "-"' >output.zip

One problem with creating a zip archive directly from STDIN can be demonstrated by looking at
the contents of the zip file, output.zip, that we have just created.

    $ unzip -l output.zip
    Archive:  output.zip
    Length      Date    Time    Name
    ---------  ---------- -----   ----
        12  2019-08-16 22:21
    ---------                     -------
        12                     1 file

The archive member (filename) used is the empty string.

If that doesn't suit your needs, you can explicitly set the filename used
in the zip archive by specifying the L<Name|"File Naming Options"> option, like so

    echo hello world | perl -MIO::Compress::Zip=zip -e 'zip "-" => "-", Name => "hello.txt"' >output.zip

Now the contents of the zip file looks like this

    $ unzip -l output.zip
    Archive:  output.zip
    Length      Date    Time    Name
    ---------  ---------- -----   ----
        12  2019-08-16 22:22   hello.txt
    ---------                     -------
        12                     1 file

=head3 Compressing a file from the filesystem

To read the contents of the file C<file1.txt> and write the compressed
data to the file C<file1.txt.zip>.

    use strict ;
    use warnings ;
    use IO::Compress::Zip qw(zip $ZipError) ;

    my $input = "file1.txt";
    zip $input => "$input.zip"
        or die "zip failed: $ZipError\n";

=head3 Reading from a Filehandle and writing to an in-memory buffer

To read from an existing Perl filehandle, C<$input>, and write the
compressed data to a buffer, C<$buffer>.

    use strict ;
    use warnings ;
    use IO::Compress::Zip qw(zip $ZipError) ;
    use IO::File ;

    my $input = IO::File->new( "<file1.txt" )
        or die "Cannot open 'file1.txt': $!\n" ;
    my $buffer ;
    zip $input => \$buffer
        or die "zip failed: $ZipError\n";

=head3 Compressing multiple files

To create a zip file, C<output.zip>, that contains the compressed contents
of the files C<alpha.txt> and C<beta.txt>

    use strict ;
    use warnings ;
    use IO::Compress::Zip qw(zip $ZipError) ;

    zip [ 'alpha.txt', 'beta.txt' ] => 'output.zip'
        or die "zip failed: $ZipError\n";

Alternatively, rather than having to explicitly name each of the files that
you want to compress, you could use a fileglob to select all the C<txt>
files in the current directory, as follows

    use strict ;
    use warnings ;
    use IO::Compress::Zip qw(zip $ZipError) ;

    my @files = <*.txt>;
    zip \@files => 'output.zip'
        or die "zip failed: $ZipError\n";

or more succinctly

    zip [ <*.txt> ] => 'output.zip'
        or die "zip failed: $ZipError\n";

=head1 OO Interface

=head2 Constructor

The format of the constructor for C<IO::Compress::Zip> is shown below

    my $z = IO::Compress::Zip->new( $output [,OPTS] )
        or die "IO::Compress::Zip failed: $ZipError\n";

It returns an C<IO::Compress::Zip> object on success and undef on failure.
The variable C<$ZipError> will contain an error message on failure.

If you are running Perl 5.005 or better the object, C<$z>, returned from
IO::Compress::Zip can be used exactly like an L<IO::File|IO::File> filehandle.
This means that all normal output file operations can be carried out
with C<$z>.
For example, to write to a compressed file/buffer you can use either of
these forms

    $z->print("hello world\n");
    print $z "hello world\n";

The mandatory parameter C<$output> is used to control the destination
of the compressed data. This parameter can take one of these forms.

=over 5

=item A filename

If the C<$output> parameter is a simple scalar, it is assumed to be a
filename. This file will be opened for writing and the compressed data
will be written to it.

=item A filehandle

If the C<$output> parameter is a filehandle, the compressed data will be
written to it.
The string '-' can be used as an alias for standard output.

=item A scalar reference

If C<$output> is a scalar reference, the compressed data will be stored
in C<$$output>.

=back

If the C<$output> parameter is any other type, C<IO::Compress::Zip>::new will
return undef.

=head2 Constructor Options

C<OPTS> is any combination of zero or more the following options:

=over 5

=item C<< AutoClose => 0|1 >>

This option is only valid when the C<$output> parameter is a filehandle. If
specified, and the value is true, it will result in the C<$output> being
closed once either the C<close> method is called or the C<IO::Compress::Zip>
object is destroyed.

This parameter defaults to 0.

=item C<< Append => 0|1 >>

Opens C<$output> in append mode.

The behaviour of this option is dependent on the type of C<$output>.

=over 5

=item * A Buffer

If C<$output> is a buffer and C<Append> is enabled, all compressed data
will be append to the end of C<$output>. Otherwise C<$output> will be
cleared before any data is written to it.

=item * A Filename

If C<$output> is a filename and C<Append> is enabled, the file will be
opened in append mode. Otherwise the contents of the file, if any, will be
truncated before any compressed data is written to it.

=item * A Filehandle

If C<$output> is a filehandle, the file pointer will be positioned to the
end of the file via a call to C<seek> before any compressed data is written
to it.  Otherwise the file pointer will not be moved.

=back

This parameter defaults to 0.

=back

=head3 File Naming Options

A quick bit of zip file terminology -- A zip archive consists of one or more I<archive members>, where each member has an associated
filename, known as the I<archive member name>.

The options listed in this section control how the I<archive member name> (or filename) is stored the zip archive.

=over 5

=item C<< Name => $string >>

This option is used to explicitly set the I<archive member name> in
the zip archive to C<$string>.
Most of the time you don't need to make use of this option.
By default when adding a filename to the zip archive, the I<archive member name> will match the filename.

You should only need to use this option if you want the I<archive member name>
to be different from the uncompressed filename or when the input is a filehandle or a buffer.

The default behaviour for what I<archive member name> is used when the C<Name> option
is I<not> specified depends on the form of the C<$input> parameter:

=over 5

=item *

If the C<$input> parameter is a filename, the
value of C<$input> will be used for the I<archive member name> .

=item *
If the C<$input> parameter is not a filename,
the I<archive member name> will be an empty string.

=back

Note that both the C<CanonicalName> and C<FilterName> options
can modify the value used for the I<archive member name>.

Also note that you should set the C<Efs> option to true if you are working
with UTF8 filenames.

=item C<< CanonicalName => 0|1 >>

This option controls whether the I<archive member name> is
I<normalized> into Unix format before being written to the zip file.

It is recommended that you enable this option unless you really need
to create a non-standard Zip file.

This is what APPNOTE.TXT has to say on what should be stored in the zip
filename header field.

    The name of the file, with optional relative path.
    The path stored should not contain a drive or
    device letter, or a leading slash.  All slashes
    should be forward slashes '/' as opposed to
    backwards slashes '\' for compatibility with Amiga
    and UNIX file systems etc.

This option defaults to B<false>.

=item C<< FilterName => sub { ... }  >>

This option allow the I<archive member> name to be modified
before it is written to the zip file.

This option takes a parameter that must be a reference to a sub.  On entry
to the sub the C<$_> variable will contain the name to be filtered. If no
filename is available C<$_> will contain an empty string.

The value of C<$_> when the sub returns will be  used as the I<archive member name>.

Note that if C<CanonicalName> is enabled, a
normalized filename will be passed to the sub.

If you use C<FilterName> to modify the filename, it is your responsibility
to keep the filename in Unix format.

Although this option can be used with the OO interface, it is of most use
with the one-shot interface. For example, the code below shows how
C<FilterName> can be used to remove the path component from a series of
filenames before they are stored in C<$zipfile>.

    sub compressTxtFiles
    {
        my $zipfile = shift ;
        my $dir     = shift ;

        zip [ <$dir/*.txt> ] => $zipfile,
            FilterName => sub { s[^$dir/][] } ;
    }

=item C<< Efs => 0|1 >>

This option controls setting of the "Language Encoding Flag" (EFS) in the zip
archive. When set, the filename and comment fields for the zip archive MUST
be valid UTF-8.

If the string used for the filename and/or comment is not valid UTF-8 when this option
is true, the script will die with a "wide character" error.

Note that this option only works with Perl 5.8.4 or better.

This option defaults to B<false>.

=back

=head3 Overall Zip Archive Structure

=over 5

=item C<< Minimal => 1|0 >>

If specified, this option will disable the creation of all extra fields
in the zip local and central headers. So the C<exTime>, C<exUnix2>,
C<exUnixN>, C<ExtraFieldLocal> and C<ExtraFieldCentral> options will
be ignored.

This parameter defaults to 0.

=item C<< Stream => 0|1 >>

This option controls whether the zip file/buffer output is created in
streaming mode.

Note that when outputting to a file with streaming mode disabled (C<Stream>
is 0), the output file must be seekable.

The default is 1.

=item C<< Zip64 => 0|1 >>

Create a Zip64 zip file/buffer. This option is used if you want
to store files larger than 4 Gig or store more than 64K files in a single
zip archive.

C<Zip64> will be automatically set, as needed, if working with the one-shot
interface when the input is either a filename or a scalar reference.

If you intend to manipulate the Zip64 zip files created with this module
using an external zip/unzip, make sure that it supports Zip64.

In particular, if you are using Info-Zip you need to have zip version 3.x
or better to update a Zip64 archive and unzip version 6.x to read a zip64
archive.

The default is 0.

=back

=head3 Deflate Compression Options

=over 5

=item -Level

Defines the compression level used by zlib. The value should either be
a number between 0 and 9 (0 means no compression and 9 is maximum
compression), or one of the symbolic constants defined below.

   Z_NO_COMPRESSION
   Z_BEST_SPEED
   Z_BEST_COMPRESSION
   Z_DEFAULT_COMPRESSION

The default is Z_DEFAULT_COMPRESSION.

Note, these constants are not imported by C<IO::Compress::Zip> by default.

    use IO::Compress::Zip qw(:strategy);
    use IO::Compress::Zip qw(:constants);
    use IO::Compress::Zip qw(:all);

=item -Strategy

Defines the strategy used to tune the compression. Use one of the symbolic
constants defined below.

   Z_FILTERED
   Z_HUFFMAN_ONLY
   Z_RLE
   Z_FIXED
   Z_DEFAULT_STRATEGY

The default is Z_DEFAULT_STRATEGY.

=back

=head3 Bzip2 Compression Options

=over 5

=item C<< BlockSize100K => number >>

Specify the number of 100K blocks bzip2 uses during compression.

Valid values are from 1 to 9, where 9 is best compression.

This option is only valid if the C<Method> is ZIP_CM_BZIP2. It is ignored
otherwise.

The default is 1.

=item C<< WorkFactor => number >>

Specifies how much effort bzip2 should take before resorting to a slower
fallback compression algorithm.

Valid values range from 0 to 250, where 0 means use the default value 30.

This option is only valid if the C<Method> is ZIP_CM_BZIP2. It is ignored
otherwise.

The default is 0.

=back

=head3 Lzma and Xz Compression Options

=over 5

=item C<< Preset => number >>

Used to choose the LZMA compression preset.

Valid values are 0-9 and C<LZMA_PRESET_DEFAULT>.

0 is the fastest compression with the lowest memory usage and the lowest
compression.

9 is the slowest compression with the highest memory usage but with the best
compression.

This option is only valid if the C<Method> is ZIP_CM_LZMA. It is ignored
otherwise.

Defaults to C<LZMA_PRESET_DEFAULT> (6).

=item C<< Extreme => 0|1 >>

Makes LZMA compression a lot slower, but a small compression gain.

This option is only valid if the C<Method> is ZIP_CM_LZMA. It is ignored
otherwise.

Defaults to 0.

=back

=head3 Other Options

=over 5

=item C<< Time => $number >>

Sets the last modified time field in the zip header to $number.

This field defaults to the time the C<IO::Compress::Zip> object was created
if this option is not specified and the C<$input> parameter is not a
filename.

=item C<< ExtAttr => $attr >>

This option controls the "external file attributes" field in the central
header of the zip file. This is a 4 byte field.

If you are running a Unix derivative this value defaults to

    0100644 << 16

This should allow read/write access to any files that are extracted from
the zip file/buffer`.

For all other systems it defaults to 0.

=item C<< exTime => [$atime, $mtime, $ctime] >>

This option expects an array reference with exactly three elements:
C<$atime>, C<mtime> and C<$ctime>. These correspond to the last access
time, last modification time and creation time respectively.

It uses these values to set the extended timestamp field (ID is "UT") in
the local zip header using the three values, $atime, $mtime, $ctime. In
addition it sets the extended timestamp field in the central zip header
using C<$mtime>.

If any of the three values is C<undef> that time value will not be used.
So, for example, to set only the C<$mtime> you would use this

    exTime => [undef, $mtime, undef]

If the C<Minimal> option is set to true, this option will be ignored.

By default no extended time field is created.

=item C<< exUnix2 => [$uid, $gid] >>

This option expects an array reference with exactly two elements: C<$uid>
and C<$gid>. These values correspond to the numeric User ID (UID) and Group ID
(GID) of the owner of the files respectively.

When the C<exUnix2> option is present it will trigger the creation of a
Unix2 extra field (ID is "Ux") in the local zip header. This will be populated
with C<$uid> and C<$gid>. An empty Unix2 extra field will also
be created in the central zip header.

Note - The UID & GID are stored as 16-bit
integers in the "Ux" field. Use C<< exUnixN >> if your UID or GID are
32-bit.

If the C<Minimal> option is set to true, this option will be ignored.

By default no Unix2 extra field is created.

=item C<< exUnixN => [$uid, $gid] >>

This option expects an array reference with exactly two elements: C<$uid>
and C<$gid>. These values correspond to the numeric User ID (UID) and Group ID
(GID) of the owner of the files respectively.

When the C<exUnixN> option is present it will trigger the creation of a
UnixN extra field (ID is "ux") in both the local and central zip headers.
This will be populated with C<$uid> and C<$gid>.
The UID & GID are stored as 32-bit integers.

If the C<Minimal> option is set to true, this option will be ignored.

By default no UnixN extra field is created.

=item C<< Comment => $comment >>

Stores the contents of C<$comment> in the Central File Header of
the zip file.

Set the C<Efs> option to true if you want to store a UTF8 comment.

By default, no comment field is written to the zip file.

=item C<< ZipComment => $comment >>

Stores the contents of C<$comment> in the End of Central Directory record
of the zip file.

By default, no comment field is written to the zip file.

=item C<< Method => $method >>

Controls which compression method is used. At present the compression
methods supported are: Store (no compression at all), Deflate,
Bzip2, Zstd, Xz and Lzma.

The symbols ZIP_CM_STORE, ZIP_CM_DEFLATE, ZIP_CM_BZIP2, ZIP_CM_ZSTD, ZIP_CM_XZ and ZIP_CM_LZMA
are used to select the compression method.

These constants are not imported by C<IO::Compress::Zip> by default.

    use IO::Compress::Zip qw(:zip_method);
    use IO::Compress::Zip qw(:constants);
    use IO::Compress::Zip qw(:all);

Note that to create Bzip2 content, the module C<IO::Compress::Bzip2> must
be installed. A fatal error will be thrown if you attempt to create Bzip2
content when C<IO::Compress::Bzip2> is not available.

Note that to create Lzma content, the module C<IO::Compress::Lzma> must
be installed. A fatal error will be thrown if you attempt to create Lzma
content when C<IO::Compress::Lzma> is not available.

Note that to create Xz content, the module C<IO::Compress::Xz> must
be installed. A fatal error will be thrown if you attempt to create Xz
content when C<IO::Compress::Xz> is not available.

Note that to create Zstd content, the module C<IO::Compress::Zstd> must
be installed. A fatal error will be thrown if you attempt to create Zstd
content when C<IO::Compress::Zstd> is not available.

The default method is ZIP_CM_DEFLATE.

=item C<< TextFlag => 0|1 >>

This parameter controls the setting of a bit in the zip central header. It
is used to signal that the data stored in the zip file/buffer is probably
text.

In one-shot mode this flag will be set to true if the Perl C<-T> operator thinks
the file contains text.

The default is 0.

=item C<< ExtraFieldLocal => $data >>

=item C<< ExtraFieldCentral => $data >>

The C<ExtraFieldLocal> option is used to store additional metadata in the
local header for the zip file/buffer. The C<ExtraFieldCentral> does the
same for the matching central header.

An extra field consists of zero or more subfields. Each subfield consists
of a two byte header followed by the subfield data.

The list of subfields can be supplied in any of the following formats

    ExtraFieldLocal => [$id1, $data1,
                        $id2, $data2,
                         ...
                       ]

    ExtraFieldLocal => [ [$id1 => $data1],
                         [$id2 => $data2],
                         ...
                       ]

    ExtraFieldLocal => { $id1 => $data1,
                         $id2 => $data2,
                         ...
                       }

Where C<$id1>, C<$id2> are two byte subfield ID's.

If you use the hash syntax, you have no control over the order in which
the ExtraSubFields are stored, plus you cannot have SubFields with
duplicate ID.

Alternatively the list of subfields can by supplied as a scalar, thus

    ExtraField => $rawdata

In this case C<IO::Compress::Zip> will check that C<$rawdata> consists of
zero or more conformant sub-fields.

The Extended Time field (ID "UT"), set using the C<exTime> option, and the
Unix2 extra field (ID "Ux), set using the C<exUnix2> option, are examples
of extra fields.

If the C<Minimal> option is set to true, this option will be ignored.

The maximum size of an extra field 65535 bytes.

=item C<< Strict => 0|1 >>

This is a placeholder option.

=back

=head2 Examples

TODO

=head1 Methods

=head2 print

Usage is

    $z->print($data)
    print $z $data

Compresses and outputs the contents of the C<$data> parameter. This
has the same behaviour as the C<print> built-in.

Returns true if successful.

=head2 printf

Usage is

    $z->printf($format, $data)
    printf $z $format, $data

Compresses and outputs the contents of the C<$data> parameter.

Returns true if successful.

=head2 syswrite

Usage is

    $z->syswrite $data
    $z->syswrite $data, $length
    $z->syswrite $data, $length, $offset

Compresses and outputs the contents of the C<$data> parameter.

Returns the number of uncompressed bytes written, or C<undef> if
unsuccessful.

=head2 write

Usage is

    $z->write $data
    $z->write $data, $length
    $z->write $data, $length, $offset

Compresses and outputs the contents of the C<$data> parameter.

Returns the number of uncompressed bytes written, or C<undef> if
unsuccessful.

=head2 flush

Usage is

    $z->flush;
    $z->flush($flush_type);

Flushes any pending compressed data to the output file/buffer.

This method takes an optional parameter, C<$flush_type>, that controls
how the flushing will be carried out. By default the C<$flush_type>
used is C<Z_FINISH>. Other valid values for C<$flush_type> are
C<Z_NO_FLUSH>, C<Z_SYNC_FLUSH>, C<Z_FULL_FLUSH> and C<Z_BLOCK>. It is
strongly recommended that you only set the C<flush_type> parameter if
you fully understand the implications of what it does - overuse of C<flush>
can seriously degrade the level of compression achieved. See the C<zlib>
documentation for details.

Returns true on success.

=head2 tell

Usage is

    $z->tell()
    tell $z

Returns the uncompressed file offset.

=head2 eof

Usage is

    $z->eof();
    eof($z);

Returns true if the C<close> method has been called.

=head2 seek

    $z->seek($position, $whence);
    seek($z, $position, $whence);

Provides a sub-set of the C<seek> functionality, with the restriction
that it is only legal to seek forward in the output file/buffer.
It is a fatal error to attempt to seek backward.

Empty parts of the file/buffer will have NULL (0x00) bytes written to them.

The C<$whence> parameter takes one the usual values, namely SEEK_SET,
SEEK_CUR or SEEK_END.

Returns 1 on success, 0 on failure.

=head2 binmode

Usage is

    $z->binmode
    binmode $z ;

This is a noop provided for completeness.

=head2 opened

    $z->opened()

Returns true if the object currently refers to a opened file/buffer.

=head2 autoflush

    my $prev = $z->autoflush()
    my $prev = $z->autoflush(EXPR)

If the C<$z> object is associated with a file or a filehandle, this method
returns the current autoflush setting for the underlying filehandle. If
C<EXPR> is present, and is non-zero, it will enable flushing after every
write/print operation.

If C<$z> is associated with a buffer, this method has no effect and always
returns C<undef>.

B<Note> that the special variable C<$|> B<cannot> be used to set or
retrieve the autoflush setting.

=head2 input_line_number

    $z->input_line_number()
    $z->input_line_number(EXPR)

This method always returns C<undef> when compressing.

=head2 fileno

    $z->fileno()
    fileno($z)

If the C<$z> object is associated with a file or a filehandle, C<fileno>
will return the underlying file descriptor. Once the C<close> method is
called C<fileno> will return C<undef>.

If the C<$z> object is associated with a buffer, this method will return
C<undef>.

=head2 close

    $z->close() ;
    close $z ;

Flushes any pending compressed data and then closes the output file/buffer.

For most versions of Perl this method will be automatically invoked if
the IO::Compress::Zip object is destroyed (either explicitly or by the
variable with the reference to the object going out of scope). The
exceptions are Perl versions 5.005 through 5.00504 and 5.8.0. In
these cases, the C<close> method will be called automatically, but
not until global destruction of all live objects when the program is
terminating.

Therefore, if you want your scripts to be able to run on all versions
of Perl, you should call C<close> explicitly and not rely on automatic
closing.

Returns true on success, otherwise 0.

If the C<AutoClose> option has been enabled when the IO::Compress::Zip
object was created, and the object is associated with a file, the
underlying file will also be closed.

=head2 newStream([OPTS])

Usage is

    $z->newStream( [OPTS] )

Closes the current compressed data stream and starts a new one.

OPTS consists of any of the options that are available when creating
the C<$z> object.

See the L</"Constructor Options"> section for more details.

=head2 deflateParams

Usage is

    $z->deflateParams

TODO

=head1 Importing

A number of symbolic constants are required by some methods in
C<IO::Compress::Zip>. None are imported by default.

=over 5

=item :all

Imports C<zip>, C<$ZipError> and all symbolic
constants that can be used by C<IO::Compress::Zip>. Same as doing this

    use IO::Compress::Zip qw(zip $ZipError :constants) ;

=item :constants

Import all symbolic constants. Same as doing this

    use IO::Compress::Zip qw(:flush :level :strategy :zip_method) ;

=item :flush

These symbolic constants are used by the C<flush> method.

    Z_NO_FLUSH
    Z_PARTIAL_FLUSH
    Z_SYNC_FLUSH
    Z_FULL_FLUSH
    Z_FINISH
    Z_BLOCK

=item :level

These symbolic constants are used by the C<Level> option in the constructor.

    Z_NO_COMPRESSION
    Z_BEST_SPEED
    Z_BEST_COMPRESSION
    Z_DEFAULT_COMPRESSION

=item :strategy

These symbolic constants are used by the C<Strategy> option in the constructor.

    Z_FILTERED
    Z_HUFFMAN_ONLY
    Z_RLE
    Z_FIXED
    Z_DEFAULT_STRATEGY

=item :zip_method

These symbolic constants are used by the C<Method> option in the
constructor.

    ZIP_CM_STORE
    ZIP_CM_DEFLATE
    ZIP_CM_BZIP2

=back

=head1 EXAMPLES

=head2 Apache::GZip Revisited

See L<IO::Compress::FAQ|IO::Compress::FAQ/"Apache::GZip Revisited">

=head2 Working with Net::FTP

See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP">

=head1 SUPPORT

General feedback/questions/bug reports should be sent to
L<https://github.com/pmqs/IO-Compress/issues> (preferred) or
L<https://rt.cpan.org/Public/Dist/Display.html?Name=IO-Compress>.

=head1 SEE ALSO

L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzip>, L<IO::Uncompress::UnLzip>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Compress::Zstd>, L<IO::Uncompress::UnZstd>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>

L<IO::Compress::FAQ|IO::Compress::FAQ>

L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>,
L<Archive::Tar|Archive::Tar>,
L<IO::Zlib|IO::Zlib>

For RFC 1950, 1951 and 1952 see
L<http://www.faqs.org/rfcs/rfc1950.html>,
L<http://www.faqs.org/rfcs/rfc1951.html> and
L<http://www.faqs.org/rfcs/rfc1952.html>

The I<zlib> compression library was written by Jean-loup Gailly
C<gzip@prep.ai.mit.edu> and Mark Adler C<madler@alumni.caltech.edu>.

The primary site for the I<zlib> compression library is
L<http://www.zlib.org>.

The primary site for gzip is L<http://www.gzip.org>.

=head1 AUTHOR

This module was written by Paul Marquess, C<pmqs@cpan.org>.

=head1 MODIFICATION HISTORY

See the Changes file.

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2005-2021 Paul Marquess. All rights reserved.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
                                                                                                                                                                                                                                                                                      Compress/Zip/Constants.pm                                                                           0000644                 00000007774 00000000000 0011373 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       package IO::Compress::Zip::Constants;

use strict ;
use warnings;

require Exporter;

our ($VERSION, @ISA, @EXPORT, %ZIP_CM_MIN_VERSIONS);

$VERSION = '2.102';

@ISA = qw(Exporter);

@EXPORT= qw(

    ZIP_CM_STORE
    ZIP_CM_DEFLATE
    ZIP_CM_BZIP2
    ZIP_CM_LZMA
    ZIP_CM_PPMD
    ZIP_CM_XZ
    ZIP_CM_ZSTD

    ZIP_LOCAL_HDR_SIG
    ZIP_DATA_HDR_SIG
    ZIP_CENTRAL_HDR_SIG
    ZIP_END_CENTRAL_HDR_SIG
    ZIP64_END_CENTRAL_REC_HDR_SIG
    ZIP64_END_CENTRAL_LOC_HDR_SIG
    ZIP64_ARCHIVE_EXTRA_SIG
    ZIP64_DIGITAL_SIGNATURE_SIG

    ZIP_GP_FLAG_ENCRYPTED_MASK
    ZIP_GP_FLAG_STREAMING_MASK
    ZIP_GP_FLAG_PATCHED_MASK
    ZIP_GP_FLAG_STRONG_ENCRYPTED_MASK
    ZIP_GP_FLAG_LZMA_EOS_PRESENT
    ZIP_GP_FLAG_LANGUAGE_ENCODING

    ZIP_EXTRA_ID_ZIP64
    ZIP_EXTRA_ID_EXT_TIMESTAMP
    ZIP_EXTRA_ID_INFO_ZIP_UNIX2
    ZIP_EXTRA_ID_INFO_ZIP_UNIXN
    ZIP_EXTRA_ID_INFO_ZIP_Upath
    ZIP_EXTRA_ID_INFO_ZIP_Ucom
    ZIP_EXTRA_ID_JAVA_EXE

    ZIP_OS_CODE_UNIX
    ZIP_OS_CODE_DEFAULT

    ZIP_IFA_TEXT_MASK

    %ZIP_CM_MIN_VERSIONS
    ZIP64_MIN_VERSION

    ZIP_A_RONLY
    ZIP_A_HIDDEN
    ZIP_A_SYSTEM
    ZIP_A_LABEL
    ZIP_A_DIR
    ZIP_A_ARCHIVE
    );

# Compression types supported
use constant ZIP_CM_STORE                      => 0 ;
use constant ZIP_CM_DEFLATE                    => 8 ;
use constant ZIP_CM_BZIP2                      => 12 ;
use constant ZIP_CM_LZMA                       => 14 ;
use constant ZIP_CM_ZSTD                       => 93 ;
use constant ZIP_CM_XZ                         => 95 ;
use constant ZIP_CM_PPMD                       => 98 ; # Not Supported yet

# General Purpose Flag
use constant ZIP_GP_FLAG_ENCRYPTED_MASK        => (1 << 0) ;
use constant ZIP_GP_FLAG_STREAMING_MASK        => (1 << 3) ;
use constant ZIP_GP_FLAG_PATCHED_MASK          => (1 << 5) ;
use constant ZIP_GP_FLAG_STRONG_ENCRYPTED_MASK => (1 << 6) ;
use constant ZIP_GP_FLAG_LZMA_EOS_PRESENT      => (1 << 1) ;
use constant ZIP_GP_FLAG_LANGUAGE_ENCODING     => (1 << 11) ;

# Internal File Attributes
use constant ZIP_IFA_TEXT_MASK                 => 1;

# Signatures for each of the headers
use constant ZIP_LOCAL_HDR_SIG                 => 0x04034b50;
use constant ZIP_DATA_HDR_SIG                  => 0x08074b50;
use constant packed_ZIP_DATA_HDR_SIG           => pack "V", ZIP_DATA_HDR_SIG;
use constant ZIP_CENTRAL_HDR_SIG               => 0x02014b50;
use constant ZIP_END_CENTRAL_HDR_SIG           => 0x06054b50;
use constant ZIP64_END_CENTRAL_REC_HDR_SIG     => 0x06064b50;
use constant ZIP64_END_CENTRAL_LOC_HDR_SIG     => 0x07064b50;
use constant ZIP64_ARCHIVE_EXTRA_SIG           => 0x08064b50;
use constant ZIP64_DIGITAL_SIGNATURE_SIG       => 0x05054b50;

use constant ZIP_OS_CODE_UNIX                  => 3;
use constant ZIP_OS_CODE_DEFAULT               => 3;

# Extra Field ID's
use constant ZIP_EXTRA_ID_ZIP64                => pack "v", 1;
use constant ZIP_EXTRA_ID_EXT_TIMESTAMP        => "UT";
use constant ZIP_EXTRA_ID_INFO_ZIP_UNIX2       => "Ux";
use constant ZIP_EXTRA_ID_INFO_ZIP_UNIXN       => "ux";
use constant ZIP_EXTRA_ID_INFO_ZIP_Upath       => "up";
use constant ZIP_EXTRA_ID_INFO_ZIP_Ucom        => "uc";
use constant ZIP_EXTRA_ID_JAVA_EXE             => pack "v", 0xCAFE;

# DOS Attributes
use constant ZIP_A_RONLY                       => 0x01;
use constant ZIP_A_HIDDEN                      => 0x02;
use constant ZIP_A_SYSTEM                      => 0x04;
use constant ZIP_A_LABEL                       => 0x08;
use constant ZIP_A_DIR                         => 0x10;
use constant ZIP_A_ARCHIVE                     => 0x20;

use constant ZIP64_MIN_VERSION                 => 45;

%ZIP_CM_MIN_VERSIONS = (
            ZIP_CM_STORE()                     => 20,
            ZIP_CM_DEFLATE()                   => 20,
            ZIP_CM_BZIP2()                     => 46,
            ZIP_CM_LZMA()                      => 63,
            ZIP_CM_PPMD()                      => 63,
            ZIP_CM_ZSTD()                      => 20, # Winzip needs these to be 20
            ZIP_CM_XZ()                        => 20,
            );


1;

__END__
    Compress/Deflate.pm                                                                                 0000644                 00000060243 00000000000 0010207 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       package IO::Compress::Deflate ;

require 5.006 ;

use strict ;
use warnings;
use bytes;

require Exporter ;

use IO::Compress::RawDeflate 2.101 ();
use IO::Compress::Adapter::Deflate 2.101 ;

use IO::Compress::Zlib::Constants 2.101 ;
use IO::Compress::Base::Common  2.101 qw();


our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $DeflateError);

$VERSION = '2.102';
$DeflateError = '';

@ISA    = qw(IO::Compress::RawDeflate Exporter);
@EXPORT_OK = qw( $DeflateError deflate ) ;
%EXPORT_TAGS = %IO::Compress::RawDeflate::DEFLATE_CONSTANTS ;

push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
Exporter::export_ok_tags('all');


sub new
{
    my $class = shift ;

    my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$DeflateError);
    return $obj->_create(undef, @_);
}

sub deflate
{
    my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$DeflateError);
    return $obj->_def(@_);
}


sub bitmask($$$$)
{
    my $into  = shift ;
    my $value  = shift ;
    my $offset = shift ;
    my $mask   = shift ;

    return $into | (($value & $mask) << $offset ) ;
}

sub mkDeflateHdr($$$;$)
{
    my $method = shift ;
    my $cinfo  = shift;
    my $level  = shift;
    my $fdict_adler = shift  ;

    my $cmf = 0;
    my $flg = 0;
    my $fdict = 0;
    $fdict = 1 if defined $fdict_adler;

    $cmf = bitmask($cmf, $method, ZLIB_CMF_CM_OFFSET,    ZLIB_CMF_CM_BITS);
    $cmf = bitmask($cmf, $cinfo,  ZLIB_CMF_CINFO_OFFSET, ZLIB_CMF_CINFO_BITS);

    $flg = bitmask($flg, $fdict,  ZLIB_FLG_FDICT_OFFSET, ZLIB_FLG_FDICT_BITS);
    $flg = bitmask($flg, $level,  ZLIB_FLG_LEVEL_OFFSET, ZLIB_FLG_LEVEL_BITS);

    my $fcheck = 31 - ($cmf * 256 + $flg) % 31 ;
    $flg = bitmask($flg, $fcheck, ZLIB_FLG_FCHECK_OFFSET, ZLIB_FLG_FCHECK_BITS);

    my $hdr =  pack("CC", $cmf, $flg) ;
    $hdr .= pack("N", $fdict_adler) if $fdict ;

    return $hdr;
}

sub mkHeader
{
    my $self = shift ;
    my $param = shift ;

    my $level = $param->getValue('level');
    my $strategy = $param->getValue('strategy');

    my $lflag ;
    $level = 6
        if $level == Z_DEFAULT_COMPRESSION ;

    if (ZLIB_VERNUM >= 0x1210)
    {
        if ($strategy >= Z_HUFFMAN_ONLY || $level < 2)
         {  $lflag = ZLIB_FLG_LEVEL_FASTEST }
        elsif ($level < 6)
         {  $lflag = ZLIB_FLG_LEVEL_FAST }
        elsif ($level == 6)
         {  $lflag = ZLIB_FLG_LEVEL_DEFAULT }
        else
         {  $lflag = ZLIB_FLG_LEVEL_SLOWEST }
    }
    else
    {
        $lflag = ($level - 1) >> 1 ;
        $lflag = 3 if $lflag > 3 ;
    }

     #my $wbits = (MAX_WBITS - 8) << 4 ;
    my $wbits = 7;
    mkDeflateHdr(ZLIB_CMF_CM_DEFLATED, $wbits, $lflag);
}

sub ckParams
{
    my $self = shift ;
    my $got = shift;

    $got->setValue('adler32' => 1);
    return 1 ;
}


sub mkTrailer
{
    my $self = shift ;
    return pack("N", *$self->{Compress}->adler32()) ;
}

sub mkFinalTrailer
{
    return '';
}

#sub newHeader
#{
#    my $self = shift ;
#    return *$self->{Header};
#}

sub getExtraParams
{
    my $self = shift ;
    return $self->getZlibParams(),
}

sub getInverseClass
{
    no warnings 'once';
    return ('IO::Uncompress::Inflate',
                \$IO::Uncompress::Inflate::InflateError);
}

sub getFileInfo
{
    my $self = shift ;
    my $params = shift;
    my $file = shift ;

}



1;

__END__

=head1 NAME

IO::Compress::Deflate - Write RFC 1950 files/buffers

=head1 SYNOPSIS

    use IO::Compress::Deflate qw(deflate $DeflateError) ;

    my $status = deflate $input => $output [,OPTS]
        or die "deflate failed: $DeflateError\n";

    my $z = IO::Compress::Deflate->new( $output [,OPTS] )
        or die "deflate failed: $DeflateError\n";

    $z->print($string);
    $z->printf($format, $string);
    $z->write($string);
    $z->syswrite($string [, $length, $offset]);
    $z->flush();
    $z->tell();
    $z->eof();
    $z->seek($position, $whence);
    $z->binmode();
    $z->fileno();
    $z->opened();
    $z->autoflush();
    $z->input_line_number();
    $z->newStream( [OPTS] );

    $z->deflateParams();

    $z->close() ;

    $DeflateError ;

    # IO::File mode

    print $z $string;
    printf $z $format, $string;
    tell $z
    eof $z
    seek $z, $position, $whence
    binmode $z
    fileno $z
    close $z ;

=head1 DESCRIPTION

This module provides a Perl interface that allows writing compressed
data to files or buffer as defined in RFC 1950.

For reading RFC 1950 files/buffers, see the companion module
L<IO::Uncompress::Inflate|IO::Uncompress::Inflate>.

=head1 Functional Interface

A top-level function, C<deflate>, is provided to carry out
"one-shot" compression between buffers and/or files. For finer
control over the compression process, see the L</"OO Interface">
section.

    use IO::Compress::Deflate qw(deflate $DeflateError) ;

    deflate $input_filename_or_reference => $output_filename_or_reference [,OPTS]
        or die "deflate failed: $DeflateError\n";

The functional interface needs Perl5.005 or better.

=head2 deflate $input_filename_or_reference => $output_filename_or_reference [, OPTS]

C<deflate> expects at least two parameters,
C<$input_filename_or_reference> and C<$output_filename_or_reference>
and zero or more optional parameters (see L</Optional Parameters>)

=head3 The C<$input_filename_or_reference> parameter

The parameter, C<$input_filename_or_reference>, is used to define the
source of the uncompressed data.

It can take one of the following forms:

=over 5

=item A filename

If the C<$input_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename. This file will be opened for reading and the
input data will be read from it.

=item A filehandle

If the C<$input_filename_or_reference> parameter is a filehandle, the input
data will be read from it.  The string '-' can be used as an alias for
standard input.

=item A scalar reference

If C<$input_filename_or_reference> is a scalar reference, the input data
will be read from C<$$input_filename_or_reference>.

=item An array reference

If C<$input_filename_or_reference> is an array reference, each element in
the array must be a filename.

The input data will be read from each file in turn.

The complete array will be walked to ensure that it only
contains valid filenames before any data is compressed.

=item An Input FileGlob string

If C<$input_filename_or_reference> is a string that is delimited by the
characters "<" and ">" C<deflate> will assume that it is an
I<input fileglob string>. The input is the list of files that match the
fileglob.

See L<File::GlobMapper|File::GlobMapper> for more details.

=back

If the C<$input_filename_or_reference> parameter is any other type,
C<undef> will be returned.

=head3 The C<$output_filename_or_reference> parameter

The parameter C<$output_filename_or_reference> is used to control the
destination of the compressed data. This parameter can take one of
these forms.

=over 5

=item A filename

If the C<$output_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename.  This file will be opened for writing and the
compressed data will be written to it.

=item A filehandle

If the C<$output_filename_or_reference> parameter is a filehandle, the
compressed data will be written to it.  The string '-' can be used as
an alias for standard output.

=item A scalar reference

If C<$output_filename_or_reference> is a scalar reference, the
compressed data will be stored in C<$$output_filename_or_reference>.

=item An Array Reference

If C<$output_filename_or_reference> is an array reference,
the compressed data will be pushed onto the array.

=item An Output FileGlob

If C<$output_filename_or_reference> is a string that is delimited by the
characters "<" and ">" C<deflate> will assume that it is an
I<output fileglob string>. The output is the list of files that match the
fileglob.

When C<$output_filename_or_reference> is an fileglob string,
C<$input_filename_or_reference> must also be a fileglob string. Anything
else is an error.

See L<File::GlobMapper|File::GlobMapper> for more details.

=back

If the C<$output_filename_or_reference> parameter is any other type,
C<undef> will be returned.

=head2 Notes

When C<$input_filename_or_reference> maps to multiple files/buffers and
C<$output_filename_or_reference> is a single
file/buffer the input files/buffers will be stored
in C<$output_filename_or_reference> as a concatenated series of compressed data streams.

=head2 Optional Parameters

The optional parameters for the one-shot function C<deflate>
are (for the most part) identical to those used with the OO interface defined in the
L</"Constructor Options"> section. The exceptions are listed below

=over 5

=item C<< AutoClose => 0|1 >>

This option applies to any input or output data streams to
C<deflate> that are filehandles.

If C<AutoClose> is specified, and the value is true, it will result in all
input and/or output filehandles being closed once C<deflate> has
completed.

This parameter defaults to 0.

=item C<< BinModeIn => 0|1 >>

This option is now a no-op. All files will be read in binmode.

=item C<< Append => 0|1 >>

The behaviour of this option is dependent on the type of output data
stream.

=over 5

=item * A Buffer

If C<Append> is enabled, all compressed data will be append to the end of
the output buffer. Otherwise the output buffer will be cleared before any
compressed data is written to it.

=item * A Filename

If C<Append> is enabled, the file will be opened in append mode. Otherwise
the contents of the file, if any, will be truncated before any compressed
data is written to it.

=item * A Filehandle

If C<Append> is enabled, the filehandle will be positioned to the end of
the file via a call to C<seek> before any compressed data is
written to it.  Otherwise the file pointer will not be moved.

=back

When C<Append> is specified, and set to true, it will I<append> all compressed
data to the output data stream.

So when the output is a filehandle it will carry out a seek to the eof
before writing any compressed data. If the output is a filename, it will be opened for
appending. If the output is a buffer, all compressed data will be
appended to the existing buffer.

Conversely when C<Append> is not specified, or it is present and is set to
false, it will operate as follows.

When the output is a filename, it will truncate the contents of the file
before writing any compressed data. If the output is a filehandle
its position will not be changed. If the output is a buffer, it will be
wiped before any compressed data is output.

Defaults to 0.

=back

=head2 Examples

Here are a few example that show the capabilities of the module.

=head3 Streaming

This very simple command line example demonstrates the streaming capabilities of the module.
The code reads data from STDIN, compresses it, and writes the compressed data to STDOUT.

    $ echo hello world | perl -MIO::Compress::Deflate=deflate -e 'deflate \*STDIN => \*STDOUT' >output.1950

The special filename "-" can be used as a standin for both C<\*STDIN> and C<\*STDOUT>,
so the above can be rewritten as

    $ echo hello world | perl -MIO::Compress::Deflate=deflate -e 'deflate "-" => "-"' >output.1950

=head3 Compressing a file from the filesystem

To read the contents of the file C<file1.txt> and write the compressed
data to the file C<file1.txt.1950>.

    use strict ;
    use warnings ;
    use IO::Compress::Deflate qw(deflate $DeflateError) ;

    my $input = "file1.txt";
    deflate $input => "$input.1950"
        or die "deflate failed: $DeflateError\n";

=head3 Reading from a Filehandle and writing to an in-memory buffer

To read from an existing Perl filehandle, C<$input>, and write the
compressed data to a buffer, C<$buffer>.

    use strict ;
    use warnings ;
    use IO::Compress::Deflate qw(deflate $DeflateError) ;
    use IO::File ;

    my $input = IO::File->new( "<file1.txt" )
        or die "Cannot open 'file1.txt': $!\n" ;
    my $buffer ;
    deflate $input => \$buffer
        or die "deflate failed: $DeflateError\n";

=head3 Compressing multiple files

To compress all files in the directory "/my/home" that match "*.txt"
and store the compressed data in the same directory

    use strict ;
    use warnings ;
    use IO::Compress::Deflate qw(deflate $DeflateError) ;

    deflate '</my/home/*.txt>' => '<*.1950>'
        or die "deflate failed: $DeflateError\n";

and if you want to compress each file one at a time, this will do the trick

    use strict ;
    use warnings ;
    use IO::Compress::Deflate qw(deflate $DeflateError) ;

    for my $input ( glob "/my/home/*.txt" )
    {
        my $output = "$input.1950" ;
        deflate $input => $output
            or die "Error compressing '$input': $DeflateError\n";
    }

=head1 OO Interface

=head2 Constructor

The format of the constructor for C<IO::Compress::Deflate> is shown below

    my $z = IO::Compress::Deflate->new( $output [,OPTS] )
        or die "IO::Compress::Deflate failed: $DeflateError\n";

It returns an C<IO::Compress::Deflate> object on success and undef on failure.
The variable C<$DeflateError> will contain an error message on failure.

If you are running Perl 5.005 or better the object, C<$z>, returned from
IO::Compress::Deflate can be used exactly like an L<IO::File|IO::File> filehandle.
This means that all normal output file operations can be carried out
with C<$z>.
For example, to write to a compressed file/buffer you can use either of
these forms

    $z->print("hello world\n");
    print $z "hello world\n";

The mandatory parameter C<$output> is used to control the destination
of the compressed data. This parameter can take one of these forms.

=over 5

=item A filename

If the C<$output> parameter is a simple scalar, it is assumed to be a
filename. This file will be opened for writing and the compressed data
will be written to it.

=item A filehandle

If the C<$output> parameter is a filehandle, the compressed data will be
written to it.
The string '-' can be used as an alias for standard output.

=item A scalar reference

If C<$output> is a scalar reference, the compressed data will be stored
in C<$$output>.

=back

If the C<$output> parameter is any other type, C<IO::Compress::Deflate>::new will
return undef.

=head2 Constructor Options

C<OPTS> is any combination of zero or more the following options:

=over 5

=item C<< AutoClose => 0|1 >>

This option is only valid when the C<$output> parameter is a filehandle. If
specified, and the value is true, it will result in the C<$output> being
closed once either the C<close> method is called or the C<IO::Compress::Deflate>
object is destroyed.

This parameter defaults to 0.

=item C<< Append => 0|1 >>

Opens C<$output> in append mode.

The behaviour of this option is dependent on the type of C<$output>.

=over 5

=item * A Buffer

If C<$output> is a buffer and C<Append> is enabled, all compressed data
will be append to the end of C<$output>. Otherwise C<$output> will be
cleared before any data is written to it.

=item * A Filename

If C<$output> is a filename and C<Append> is enabled, the file will be
opened in append mode. Otherwise the contents of the file, if any, will be
truncated before any compressed data is written to it.

=item * A Filehandle

If C<$output> is a filehandle, the file pointer will be positioned to the
end of the file via a call to C<seek> before any compressed data is written
to it.  Otherwise the file pointer will not be moved.

=back

This parameter defaults to 0.

=item C<< Merge => 0|1 >>

This option is used to compress input data and append it to an existing
compressed data stream in C<$output>. The end result is a single compressed
data stream stored in C<$output>.

It is a fatal error to attempt to use this option when C<$output> is not an
RFC 1950 data stream.

There are a number of other limitations with the C<Merge> option:

=over 5

=item 1

This module needs to have been built with zlib 1.2.1 or better to work. A
fatal error will be thrown if C<Merge> is used with an older version of
zlib.

=item 2

If C<$output> is a file or a filehandle, it must be seekable.

=back

This parameter defaults to 0.

=item -Level

Defines the compression level used by zlib. The value should either be
a number between 0 and 9 (0 means no compression and 9 is maximum
compression), or one of the symbolic constants defined below.

   Z_NO_COMPRESSION
   Z_BEST_SPEED
   Z_BEST_COMPRESSION
   Z_DEFAULT_COMPRESSION

The default is Z_DEFAULT_COMPRESSION.

Note, these constants are not imported by C<IO::Compress::Deflate> by default.

    use IO::Compress::Deflate qw(:strategy);
    use IO::Compress::Deflate qw(:constants);
    use IO::Compress::Deflate qw(:all);

=item -Strategy

Defines the strategy used to tune the compression. Use one of the symbolic
constants defined below.

   Z_FILTERED
   Z_HUFFMAN_ONLY
   Z_RLE
   Z_FIXED
   Z_DEFAULT_STRATEGY

The default is Z_DEFAULT_STRATEGY.

=item C<< Strict => 0|1 >>

This is a placeholder option.

=back

=head2 Examples

TODO

=head1 Methods

=head2 print

Usage is

    $z->print($data)
    print $z $data

Compresses and outputs the contents of the C<$data> parameter. This
has the same behaviour as the C<print> built-in.

Returns true if successful.

=head2 printf

Usage is

    $z->printf($format, $data)
    printf $z $format, $data

Compresses and outputs the contents of the C<$data> parameter.

Returns true if successful.

=head2 syswrite

Usage is

    $z->syswrite $data
    $z->syswrite $data, $length
    $z->syswrite $data, $length, $offset

Compresses and outputs the contents of the C<$data> parameter.

Returns the number of uncompressed bytes written, or C<undef> if
unsuccessful.

=head2 write

Usage is

    $z->write $data
    $z->write $data, $length
    $z->write $data, $length, $offset

Compresses and outputs the contents of the C<$data> parameter.

Returns the number of uncompressed bytes written, or C<undef> if
unsuccessful.

=head2 flush

Usage is

    $z->flush;
    $z->flush($flush_type);

Flushes any pending compressed data to the output file/buffer.

This method takes an optional parameter, C<$flush_type>, that controls
how the flushing will be carried out. By default the C<$flush_type>
used is C<Z_FINISH>. Other valid values for C<$flush_type> are
C<Z_NO_FLUSH>, C<Z_SYNC_FLUSH>, C<Z_FULL_FLUSH> and C<Z_BLOCK>. It is
strongly recommended that you only set the C<flush_type> parameter if
you fully understand the implications of what it does - overuse of C<flush>
can seriously degrade the level of compression achieved. See the C<zlib>
documentation for details.

Returns true on success.

=head2 tell

Usage is

    $z->tell()
    tell $z

Returns the uncompressed file offset.

=head2 eof

Usage is

    $z->eof();
    eof($z);

Returns true if the C<close> method has been called.

=head2 seek

    $z->seek($position, $whence);
    seek($z, $position, $whence);

Provides a sub-set of the C<seek> functionality, with the restriction
that it is only legal to seek forward in the output file/buffer.
It is a fatal error to attempt to seek backward.

Empty parts of the file/buffer will have NULL (0x00) bytes written to them.

The C<$whence> parameter takes one the usual values, namely SEEK_SET,
SEEK_CUR or SEEK_END.

Returns 1 on success, 0 on failure.

=head2 binmode

Usage is

    $z->binmode
    binmode $z ;

This is a noop provided for completeness.

=head2 opened

    $z->opened()

Returns true if the object currently refers to a opened file/buffer.

=head2 autoflush

    my $prev = $z->autoflush()
    my $prev = $z->autoflush(EXPR)

If the C<$z> object is associated with a file or a filehandle, this method
returns the current autoflush setting for the underlying filehandle. If
C<EXPR> is present, and is non-zero, it will enable flushing after every
write/print operation.

If C<$z> is associated with a buffer, this method has no effect and always
returns C<undef>.

B<Note> that the special variable C<$|> B<cannot> be used to set or
retrieve the autoflush setting.

=head2 input_line_number

    $z->input_line_number()
    $z->input_line_number(EXPR)

This method always returns C<undef> when compressing.

=head2 fileno

    $z->fileno()
    fileno($z)

If the C<$z> object is associated with a file or a filehandle, C<fileno>
will return the underlying file descriptor. Once the C<close> method is
called C<fileno> will return C<undef>.

If the C<$z> object is associated with a buffer, this method will return
C<undef>.

=head2 close

    $z->close() ;
    close $z ;

Flushes any pending compressed data and then closes the output file/buffer.

For most versions of Perl this method will be automatically invoked if
the IO::Compress::Deflate object is destroyed (either explicitly or by the
variable with the reference to the object going out of scope). The
exceptions are Perl versions 5.005 through 5.00504 and 5.8.0. In
these cases, the C<close> method will be called automatically, but
not until global destruction of all live objects when the program is
terminating.

Therefore, if you want your scripts to be able to run on all versions
of Perl, you should call C<close> explicitly and not rely on automatic
closing.

Returns true on success, otherwise 0.

If the C<AutoClose> option has been enabled when the IO::Compress::Deflate
object was created, and the object is associated with a file, the
underlying file will also be closed.

=head2 newStream([OPTS])

Usage is

    $z->newStream( [OPTS] )

Closes the current compressed data stream and starts a new one.

OPTS consists of any of the options that are available when creating
the C<$z> object.

See the L</"Constructor Options"> section for more details.

=head2 deflateParams

Usage is

    $z->deflateParams

TODO

=head1 Importing

A number of symbolic constants are required by some methods in
C<IO::Compress::Deflate>. None are imported by default.

=over 5

=item :all

Imports C<deflate>, C<$DeflateError> and all symbolic
constants that can be used by C<IO::Compress::Deflate>. Same as doing this

    use IO::Compress::Deflate qw(deflate $DeflateError :constants) ;

=item :constants

Import all symbolic constants. Same as doing this

    use IO::Compress::Deflate qw(:flush :level :strategy) ;

=item :flush

These symbolic constants are used by the C<flush> method.

    Z_NO_FLUSH
    Z_PARTIAL_FLUSH
    Z_SYNC_FLUSH
    Z_FULL_FLUSH
    Z_FINISH
    Z_BLOCK

=item :level

These symbolic constants are used by the C<Level> option in the constructor.

    Z_NO_COMPRESSION
    Z_BEST_SPEED
    Z_BEST_COMPRESSION
    Z_DEFAULT_COMPRESSION

=item :strategy

These symbolic constants are used by the C<Strategy> option in the constructor.

    Z_FILTERED
    Z_HUFFMAN_ONLY
    Z_RLE
    Z_FIXED
    Z_DEFAULT_STRATEGY

=back

=head1 EXAMPLES

=head2 Apache::GZip Revisited

See L<IO::Compress::FAQ|IO::Compress::FAQ/"Apache::GZip Revisited">

=head2 Working with Net::FTP

See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP">

=head1 SUPPORT

General feedback/questions/bug reports should be sent to
L<https://github.com/pmqs/IO-Compress/issues> (preferred) or
L<https://rt.cpan.org/Public/Dist/Display.html?Name=IO-Compress>.

=head1 SEE ALSO

L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzip>, L<IO::Uncompress::UnLzip>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Compress::Zstd>, L<IO::Uncompress::UnZstd>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>

L<IO::Compress::FAQ|IO::Compress::FAQ>

L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>,
L<Archive::Tar|Archive::Tar>,
L<IO::Zlib|IO::Zlib>

For RFC 1950, 1951 and 1952 see
L<http://www.faqs.org/rfcs/rfc1950.html>,
L<http://www.faqs.org/rfcs/rfc1951.html> and
L<http://www.faqs.org/rfcs/rfc1952.html>

The I<zlib> compression library was written by Jean-loup Gailly
C<gzip@prep.ai.mit.edu> and Mark Adler C<madler@alumni.caltech.edu>.

The primary site for the I<zlib> compression library is
L<http://www.zlib.org>.

The primary site for gzip is L<http://www.gzip.org>.

=head1 AUTHOR

This module was written by Paul Marquess, C<pmqs@cpan.org>.

=head1 MODIFICATION HISTORY

See the Changes file.

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2005-2021 Paul Marquess. All rights reserved.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
                                                                                                                                                                                                                                                                                                                                                             Compress/Adapter/Deflate.pm                                                                         0000644                 00000005741 00000000000 0011571 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       package IO::Compress::Adapter::Deflate ;

use strict;
use warnings;
use bytes;

use IO::Compress::Base::Common 2.101 qw(:Status);
use Compress::Raw::Zlib  2.101 qw( !crc32 !adler32 ) ;

require Exporter;
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, @EXPORT, %DEFLATE_CONSTANTS);

$VERSION = '2.102';
@ISA = qw(Exporter);
@EXPORT_OK = @Compress::Raw::Zlib::DEFLATE_CONSTANTS;
%EXPORT_TAGS = %Compress::Raw::Zlib::DEFLATE_CONSTANTS;
@EXPORT = @EXPORT_OK;
%DEFLATE_CONSTANTS = %EXPORT_TAGS ;

sub mkCompObject
{
    my $crc32    = shift ;
    my $adler32  = shift ;
    my $level    = shift ;
    my $strategy = shift ;

    my ($def, $status) = Compress::Raw::Zlib::Deflate->new(
                                -AppendOutput   => 1,
                                -CRC32          => $crc32,
                                -ADLER32        => $adler32,
                                -Level          => $level,
                                -Strategy       => $strategy,
                                -WindowBits     => - MAX_WBITS);

    return (undef, "Cannot create Deflate object: $status", $status)
        if $status != Z_OK;

    return bless {'Def'        => $def,
                  'Error'      => '',
                 } ;
}

sub compr
{
    my $self = shift ;

    my $def   = $self->{Def};

    my $status = $def->deflate($_[0], $_[1]) ;
    $self->{ErrorNo} = $status;

    if ($status != Z_OK)
    {
        $self->{Error} = "Deflate Error: $status";
        return STATUS_ERROR;
    }

    return STATUS_OK;
}

sub flush
{
    my $self = shift ;

    my $def   = $self->{Def};

    my $opt = $_[1] || Z_FINISH;
    my $status = $def->flush($_[0], $opt);
    $self->{ErrorNo} = $status;

    if ($status != Z_OK)
    {
        $self->{Error} = "Deflate Error: $status";
        return STATUS_ERROR;
    }

    return STATUS_OK;
}

sub close
{
    my $self = shift ;

    my $def   = $self->{Def};

    $def->flush($_[0], Z_FINISH)
        if defined $def ;
}

sub reset
{
    my $self = shift ;

    my $def   = $self->{Def};

    my $status = $def->deflateReset() ;
    $self->{ErrorNo} = $status;
    if ($status != Z_OK)
    {
        $self->{Error} = "Deflate Error: $status";
        return STATUS_ERROR;
    }

    return STATUS_OK;
}

sub deflateParams
{
    my $self = shift ;

    my $def   = $self->{Def};

    my $status = $def->deflateParams(@_);
    $self->{ErrorNo} = $status;
    if ($status != Z_OK)
    {
        $self->{Error} = "deflateParams Error: $status";
        return STATUS_ERROR;
    }

    return STATUS_OK;
}



#sub total_out
#{
#    my $self = shift ;
#    $self->{Def}->total_out();
#}
#
#sub total_in
#{
#    my $self = shift ;
#    $self->{Def}->total_in();
#}

sub compressedBytes
{
    my $self = shift ;

    $self->{Def}->compressedBytes();
}

sub uncompressedBytes
{
    my $self = shift ;
    $self->{Def}->uncompressedBytes();
}




sub crc32
{
    my $self = shift ;
    $self->{Def}->crc32();
}

sub adler32
{
    my $self = shift ;
    $self->{Def}->adler32();
}


1;

__END__
                               Compress/Adapter/Identity.pm                                                                        0000644                 00000002607 00000000000 0012014 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       package IO::Compress::Adapter::Identity ;

use strict;
use warnings;
use bytes;

use IO::Compress::Base::Common  2.101 qw(:Status);
our ($VERSION);

$VERSION = '2.102';

sub mkCompObject
{
    my $level    = shift ;
    my $strategy = shift ;

    return bless {
                  'CompSize'   => 0,
                  'UnCompSize' => 0,
                  'Error'      => '',
                  'ErrorNo'    => 0,
                 } ;
}

sub compr
{
    my $self = shift ;

    if (defined ${ $_[0] } && length ${ $_[0] }) {
        $self->{CompSize} += length ${ $_[0] } ;
        $self->{UnCompSize} = $self->{CompSize} ;

        if ( ref $_[1] )
          { ${ $_[1] } .= ${ $_[0] } }
        else
          { $_[1] .= ${ $_[0] } }
    }

    return STATUS_OK ;
}

sub flush
{
    my $self = shift ;

    return STATUS_OK;
}

sub close
{
    my $self = shift ;

    return STATUS_OK;
}

sub reset
{
    my $self = shift ;

    $self->{CompSize}   = 0;
    $self->{UnCompSize} = 0;

    return STATUS_OK;
}

sub deflateParams
{
    my $self = shift ;

    return STATUS_OK;
}

#sub total_out
#{
#    my $self = shift ;
#    return $self->{UnCompSize} ;
#}
#
#sub total_in
#{
#    my $self = shift ;
#    return $self->{UnCompSize} ;
#}

sub compressedBytes
{
    my $self = shift ;
    return $self->{UnCompSize} ;
}

sub uncompressedBytes
{
    my $self = shift ;
    return $self->{UnCompSize} ;
}

1;


__END__
                                                                                                                         Compress/Adapter/Bzip2.pm                                                                           0000644                 00000005004 00000000000 0011203 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       package IO::Compress::Adapter::Bzip2 ;

use strict;
use warnings;
use bytes;

use IO::Compress::Base::Common  2.101 qw(:Status);

use Compress::Raw::Bzip2  2.101 ;

our ($VERSION);
$VERSION = '2.102';

sub mkCompObject
{
    my $BlockSize100K = shift ;
    my $WorkFactor = shift ;
    my $Verbosity  = shift ;

    $BlockSize100K = 1 if ! defined $BlockSize100K ;
    $WorkFactor    = 0 if ! defined $WorkFactor ;
    $Verbosity     = 0 if ! defined $Verbosity ;

    my ($def, $status) = Compress::Raw::Bzip2->new(1, $BlockSize100K,
                                                 $WorkFactor, $Verbosity);

    return (undef, "Could not create Deflate object: $status", $status)
        if $status != BZ_OK ;

    return bless {'Def'        => $def,
                  'Error'      => '',
                  'ErrorNo'    => 0,
                 }  ;
}

sub compr
{
    my $self = shift ;

    my $def   = $self->{Def};

    my $status = $def->bzdeflate($_[0], $_[1]) ;
    $self->{ErrorNo} = $status;

    if ($status != BZ_RUN_OK)
    {
        $self->{Error} = "Deflate Error: $status";
        return STATUS_ERROR;
    }

    return STATUS_OK;
}

sub flush
{
    my $self = shift ;

    my $def   = $self->{Def};

    my $status = $def->bzflush($_[0]);
    $self->{ErrorNo} = $status;

    if ($status != BZ_RUN_OK)
    {
        $self->{Error} = "Deflate Error: $status";
        return STATUS_ERROR;
    }

    return STATUS_OK;

}

sub close
{
    my $self = shift ;

    my $def   = $self->{Def};

    my $status = $def->bzclose($_[0]);
    $self->{ErrorNo} = $status;

    if ($status != BZ_STREAM_END)
    {
        $self->{Error} = "Deflate Error: $status";
        return STATUS_ERROR;
    }

    return STATUS_OK;

}


sub reset
{
    my $self = shift ;

    my $outer = $self->{Outer};

    my ($def, $status) = Compress::Raw::Bzip2->new();
    $self->{ErrorNo} = ($status == BZ_OK) ? 0 : $status ;

    if ($status != BZ_OK)
    {
        $self->{Error} = "Cannot create Deflate object: $status";
        return STATUS_ERROR;
    }

    $self->{Def} = $def;

    return STATUS_OK;
}

sub compressedBytes
{
    my $self = shift ;
    $self->{Def}->compressedBytes();
}

sub uncompressedBytes
{
    my $self = shift ;
    $self->{Def}->uncompressedBytes();
}

#sub total_out
#{
#    my $self = shift ;
#    0;
#}
#

#sub total_in
#{
#    my $self = shift ;
#    $self->{Def}->total_in();
#}
#
#sub crc32
#{
#    my $self = shift ;
#    $self->{Def}->crc32();
#}
#
#sub adler32
#{
#    my $self = shift ;
#    $self->{Def}->adler32();
#}


1;

__END__
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            Compress/Gzip/Constants.pm                                                                          0000644                 00000007453 00000000000 0011534 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       package IO::Compress::Gzip::Constants;

use strict ;
use warnings;
use bytes;

require Exporter;

our ($VERSION, @ISA, @EXPORT, %GZIP_OS_Names);
our ($GZIP_FNAME_INVALID_CHAR_RE, $GZIP_FCOMMENT_INVALID_CHAR_RE);

$VERSION = '2.102';

@ISA = qw(Exporter);

@EXPORT= qw(

    GZIP_ID_SIZE
    GZIP_ID1
    GZIP_ID2

    GZIP_FLG_DEFAULT
    GZIP_FLG_FTEXT
    GZIP_FLG_FHCRC
    GZIP_FLG_FEXTRA
    GZIP_FLG_FNAME
    GZIP_FLG_FCOMMENT
    GZIP_FLG_RESERVED

    GZIP_CM_DEFLATED

    GZIP_MIN_HEADER_SIZE
    GZIP_TRAILER_SIZE

    GZIP_MTIME_DEFAULT
    GZIP_XFL_DEFAULT
    GZIP_FEXTRA_HEADER_SIZE
    GZIP_FEXTRA_MAX_SIZE
    GZIP_FEXTRA_SUBFIELD_HEADER_SIZE
    GZIP_FEXTRA_SUBFIELD_ID_SIZE
    GZIP_FEXTRA_SUBFIELD_LEN_SIZE
    GZIP_FEXTRA_SUBFIELD_MAX_SIZE

    $GZIP_FNAME_INVALID_CHAR_RE
    $GZIP_FCOMMENT_INVALID_CHAR_RE

    GZIP_FHCRC_SIZE

    GZIP_ISIZE_MAX
    GZIP_ISIZE_MOD_VALUE


    GZIP_NULL_BYTE

    GZIP_OS_DEFAULT

    %GZIP_OS_Names

    GZIP_MINIMUM_HEADER

    );

# Constant names derived from RFC 1952

use constant GZIP_ID_SIZE                     => 2 ;
use constant GZIP_ID1                         => 0x1F;
use constant GZIP_ID2                         => 0x8B;

use constant GZIP_MIN_HEADER_SIZE             => 10 ;# minimum gzip header size
use constant GZIP_TRAILER_SIZE                => 8 ;


use constant GZIP_FLG_DEFAULT                 => 0x00 ;
use constant GZIP_FLG_FTEXT                   => 0x01 ;
use constant GZIP_FLG_FHCRC                   => 0x02 ; # called CONTINUATION in gzip
use constant GZIP_FLG_FEXTRA                  => 0x04 ;
use constant GZIP_FLG_FNAME                   => 0x08 ;
use constant GZIP_FLG_FCOMMENT                => 0x10 ;
#use constant GZIP_FLG_ENCRYPTED              => 0x20 ; # documented in gzip sources
use constant GZIP_FLG_RESERVED                => (0x20 | 0x40 | 0x80) ;

use constant GZIP_XFL_DEFAULT                 => 0x00 ;

use constant GZIP_MTIME_DEFAULT               => 0x00 ;

use constant GZIP_FEXTRA_HEADER_SIZE          => 2 ;
use constant GZIP_FEXTRA_MAX_SIZE             => 0xFFFF ;
use constant GZIP_FEXTRA_SUBFIELD_ID_SIZE     => 2 ;
use constant GZIP_FEXTRA_SUBFIELD_LEN_SIZE    => 2 ;
use constant GZIP_FEXTRA_SUBFIELD_HEADER_SIZE => GZIP_FEXTRA_SUBFIELD_ID_SIZE +
                                                 GZIP_FEXTRA_SUBFIELD_LEN_SIZE;
use constant GZIP_FEXTRA_SUBFIELD_MAX_SIZE    => GZIP_FEXTRA_MAX_SIZE -
                                                 GZIP_FEXTRA_SUBFIELD_HEADER_SIZE ;


if (ord('A') == 193)
{
    # EBCDIC
    $GZIP_FNAME_INVALID_CHAR_RE = '[\x00-\x3f\xff]';
    $GZIP_FCOMMENT_INVALID_CHAR_RE = '[\x00-\x0a\x11-\x14\x16-\x3f\xff]';

}
else
{
    $GZIP_FNAME_INVALID_CHAR_RE       =  '[\x00-\x1F\x7F-\x9F]';
    $GZIP_FCOMMENT_INVALID_CHAR_RE    =  '[\x00-\x09\x11-\x1F\x7F-\x9F]';
}

use constant GZIP_FHCRC_SIZE        => 2 ; # aka CONTINUATION in gzip

use constant GZIP_CM_DEFLATED       => 8 ;

use constant GZIP_NULL_BYTE         => "\x00";
use constant GZIP_ISIZE_MAX         => 0xFFFFFFFF ;
use constant GZIP_ISIZE_MOD_VALUE   => GZIP_ISIZE_MAX + 1 ;

# OS Names sourced from http://www.gzip.org/format.txt

use constant GZIP_OS_DEFAULT=> 0xFF ;
%GZIP_OS_Names = (
    0   => 'MS-DOS',
    1   => 'Amiga',
    2   => 'VMS',
    3   => 'Unix',
    4   => 'VM/CMS',
    5   => 'Atari TOS',
    6   => 'HPFS (OS/2, NT)',
    7   => 'Macintosh',
    8   => 'Z-System',
    9   => 'CP/M',
    10  => 'TOPS-20',
    11  => 'NTFS (NT)',
    12  => 'SMS QDOS',
    13  => 'Acorn RISCOS',
    14  => 'VFAT file system (Win95, NT)',
    15  => 'MVS',
    16  => 'BeOS',
    17  => 'Tandem/NSK',
    18  => 'THEOS',
    GZIP_OS_DEFAULT()   => 'Unknown',
    ) ;

use constant GZIP_MINIMUM_HEADER =>   pack("C4 V C C",
        GZIP_ID1, GZIP_ID2, GZIP_CM_DEFLATED, GZIP_FLG_DEFAULT,
        GZIP_MTIME_DEFAULT, GZIP_XFL_DEFAULT, GZIP_OS_DEFAULT) ;


1;
                                                                                                                                                                                                                     Compress/FAQ.pod                                                                                    0000644                 00000051005 00000000000 0007414 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       
=head1 NAME

IO::Compress::FAQ -- Frequently Asked Questions about IO::Compress

=head1 DESCRIPTION

Common questions answered.

=head1 GENERAL

=head2 Compatibility with Unix compress/uncompress.

Although C<Compress::Zlib> has a pair of functions called C<compress> and
C<uncompress>, they are I<not> related to the Unix programs of the same
name. The C<Compress::Zlib> module is not compatible with Unix
C<compress>.

If you have the C<uncompress> program available, you can use this to read
compressed files

    open F, "uncompress -c $filename |";
    while (<F>)
    {
        ...

Alternatively, if you have the C<gunzip> program available, you can use
this to read compressed files

    open F, "gunzip -c $filename |";
    while (<F>)
    {
        ...

and this to write compress files, if you have the C<compress> program
available

    open F, "| compress -c $filename ";
    print F "data";
    ...
    close F ;

=head2 Accessing .tar.Z files

The C<Archive::Tar> module can optionally use C<Compress::Zlib> (via the
C<IO::Zlib> module) to access tar files that have been compressed with
C<gzip>. Unfortunately tar files compressed with the Unix C<compress>
utility cannot be read by C<Compress::Zlib> and so cannot be directly
accessed by C<Archive::Tar>.

If the C<uncompress> or C<gunzip> programs are available, you can use one
of these workarounds to read C<.tar.Z> files from C<Archive::Tar>

Firstly with C<uncompress>

    use strict;
    use warnings;
    use Archive::Tar;

    open F, "uncompress -c $filename |";
    my $tar = Archive::Tar->new(*F);
    ...

and this with C<gunzip>

    use strict;
    use warnings;
    use Archive::Tar;

    open F, "gunzip -c $filename |";
    my $tar = Archive::Tar->new(*F);
    ...

Similarly, if the C<compress> program is available, you can use this to
write a C<.tar.Z> file

    use strict;
    use warnings;
    use Archive::Tar;
    use IO::File;

    my $fh = IO::File->new( "| compress -c >$filename" );
    my $tar = Archive::Tar->new();
    ...
    $tar->write($fh);
    $fh->close ;

=head2 How do I recompress using a different compression?

This is easier that you might expect if you realise that all the
C<IO::Compress::*> objects are derived from C<IO::File> and that all the
C<IO::Uncompress::*> modules can read from an C<IO::File> filehandle.

So, for example, say you have a file compressed with gzip that you want to
recompress with bzip2. Here is all that is needed to carry out the
recompression.

    use IO::Uncompress::Gunzip ':all';
    use IO::Compress::Bzip2 ':all';

    my $gzipFile = "somefile.gz";
    my $bzipFile = "somefile.bz2";

    my $gunzip = IO::Uncompress::Gunzip->new( $gzipFile )
        or die "Cannot gunzip $gzipFile: $GunzipError\n" ;

    bzip2 $gunzip => $bzipFile
        or die "Cannot bzip2 to $bzipFile: $Bzip2Error\n" ;

Note, there is a limitation of this technique. Some compression file
formats store extra information along with the compressed data payload. For
example, gzip can optionally store the original filename and Zip stores a
lot of information about the original file. If the original compressed file
contains any of this extra information, it will not be transferred to the
new compressed file using the technique above.

=head1 ZIP

=head2 What Compression Types do IO::Compress::Zip & IO::Uncompress::Unzip support?

The following compression formats are supported by C<IO::Compress::Zip> and
C<IO::Uncompress::Unzip>

=over 5

=item * Store (method 0)

No compression at all.

=item * Deflate (method 8)

This is the default compression used when creating a zip file with
C<IO::Compress::Zip>.

=item * Bzip2 (method 12)

Only supported if the C<IO-Compress-Bzip2> module is installed.

=item * Lzma (method 14)

Only supported if the C<IO-Compress-Lzma> module is installed.

=back

=head2 Can I Read/Write Zip files larger the 4 Gig?

Yes, both the C<IO-Compress-Zip> and C<IO-Uncompress-Unzip>  modules
support the zip feature called I<Zip64>. That allows them to read/write
files/buffers larger than 4Gig.

If you are creating a Zip file using the one-shot interface, and any of the
input files is greater than 4Gig, a zip64 complaint zip file will be
created.

    zip "really-large-file" => "my.zip";

Similarly with the one-shot interface, if the input is a buffer larger than
4 Gig, a zip64 complaint zip file will be created.

    zip \$really_large_buffer => "my.zip";

The one-shot interface allows you to force the creation of a zip64 zip file
by including the C<Zip64> option.

    zip $filehandle => "my.zip", Zip64 => 1;

If you want to create a zip64 zip file with the OO interface you must
specify the C<Zip64> option.

    my $zip = IO::Compress::Zip->new( "whatever", Zip64 => 1 );

When uncompressing with C<IO-Uncompress-Unzip>, it will automatically
detect if the zip file is zip64.

If you intend to manipulate the Zip64 zip files created with
C<IO-Compress-Zip> using an external zip/unzip, make sure that it supports
Zip64.

In particular, if you are using Info-Zip you need to have zip version 3.x
or better to update a Zip64 archive and unzip version 6.x to read a zip64
archive.

=head2 Can I write more that 64K entries is a Zip files?

Yes. Zip64 allows this. See previous question.

=head2 Zip Resources

The primary reference for zip files is the "appnote" document available at
L<http://www.pkware.com/documents/casestudies/APPNOTE.TXT>

An alternatively is the Info-Zip appnote. This is available from
L<ftp://ftp.info-zip.org/pub/infozip/doc/>

=head1 GZIP

=head2 Gzip Resources

The primary reference for gzip files is RFC 1952
L<http://www.faqs.org/rfcs/rfc1952.html>

The primary site for gzip is L<http://www.gzip.org>.

=head2 Dealing with concatenated gzip files

If the gunzip program encounters a file containing multiple gzip files
concatenated together it will automatically uncompress them all.
The example below illustrates this behaviour

    $ echo abc | gzip -c >x.gz
    $ echo def | gzip -c >>x.gz
    $ gunzip -c x.gz
    abc
    def

By default C<IO::Uncompress::Gunzip> will I<not> behave like the gunzip
program. It will only uncompress the first gzip data stream in the file, as
shown below

    $ perl -MIO::Uncompress::Gunzip=:all -e 'gunzip "x.gz" => \*STDOUT'
    abc

To force C<IO::Uncompress::Gunzip> to uncompress all the gzip data streams,
include the C<MultiStream> option, as shown below

    $ perl -MIO::Uncompress::Gunzip=:all -e 'gunzip "x.gz" => \*STDOUT, MultiStream => 1'
    abc
    def

=head2 Reading bgzip files with IO::Uncompress::Gunzip

A C<bgzip> file consists of a series of valid gzip-compliant data streams
concatenated together. To read a file created by C<bgzip> with
C<IO::Uncompress::Gunzip> use the C<MultiStream> option as shown in the
previous section.

See the section titled "The BGZF compression format" in
L<http://samtools.github.io/hts-specs/SAMv1.pdf> for a definition of
C<bgzip>.

=head1 ZLIB

=head2 Zlib Resources

The primary site for the I<zlib> compression library is
L<http://www.zlib.org>.

=head1 Bzip2

=head2 Bzip2 Resources

The primary site for bzip2 is L<http://www.bzip.org>.

=head2 Dealing with Concatenated bzip2 files

If the bunzip2 program encounters a file containing multiple bzip2 files
concatenated together it will automatically uncompress them all.
The example below illustrates this behaviour

    $ echo abc | bzip2 -c >x.bz2
    $ echo def | bzip2 -c >>x.bz2
    $ bunzip2 -c x.bz2
    abc
    def

By default C<IO::Uncompress::Bunzip2> will I<not> behave like the bunzip2
program. It will only uncompress the first bunzip2 data stream in the file, as
shown below

    $ perl -MIO::Uncompress::Bunzip2=:all -e 'bunzip2 "x.bz2" => \*STDOUT'
    abc

To force C<IO::Uncompress::Bunzip2> to uncompress all the bzip2 data streams,
include the C<MultiStream> option, as shown below

    $ perl -MIO::Uncompress::Bunzip2=:all -e 'bunzip2 "x.bz2" => \*STDOUT, MultiStream => 1'
    abc
    def

=head2 Interoperating with Pbzip2

Pbzip2 (L<http://compression.ca/pbzip2/>) is a parallel implementation of
bzip2. The output from pbzip2 consists of a series of concatenated bzip2
data streams.

By default C<IO::Uncompress::Bzip2> will only uncompress the first bzip2
data stream in a pbzip2 file. To uncompress the complete pbzip2 file you
must include the C<MultiStream> option, like this.

    bunzip2 $input => \$output, MultiStream => 1
        or die "bunzip2 failed: $Bunzip2Error\n";

=head1 HTTP & NETWORK

=head2 Apache::GZip Revisited

Below is a mod_perl Apache compression module, called C<Apache::GZip>,
taken from
L<http://perl.apache.org/docs/tutorials/tips/mod_perl_tricks/mod_perl_tricks.html#On_the_Fly_Compression>

  package Apache::GZip;
  #File: Apache::GZip.pm

  use strict vars;
  use Apache::Constants ':common';
  use Compress::Zlib;
  use IO::File;
  use constant GZIP_MAGIC => 0x1f8b;
  use constant OS_MAGIC => 0x03;

  sub handler {
      my $r = shift;
      my ($fh,$gz);
      my $file = $r->filename;
      return DECLINED unless $fh=IO::File->new($file);
      $r->header_out('Content-Encoding'=>'gzip');
      $r->send_http_header;
      return OK if $r->header_only;

      tie *STDOUT,'Apache::GZip',$r;
      print($_) while <$fh>;
      untie *STDOUT;
      return OK;
  }

  sub TIEHANDLE {
      my($class,$r) = @_;
      # initialize a deflation stream
      my $d = deflateInit(-WindowBits=>-MAX_WBITS()) || return undef;

      # gzip header -- don't ask how I found out
      $r->print(pack("nccVcc",GZIP_MAGIC,Z_DEFLATED,0,time(),0,OS_MAGIC));

      return bless { r   => $r,
                     crc =>  crc32(undef),
                     d   => $d,
                     l   =>  0
                   },$class;
  }

  sub PRINT {
      my $self = shift;
      foreach (@_) {
        # deflate the data
        my $data = $self->{d}->deflate($_);
        $self->{r}->print($data);
        # keep track of its length and crc
        $self->{l} += length($_);
        $self->{crc} = crc32($_,$self->{crc});
      }
  }

  sub DESTROY {
     my $self = shift;

     # flush the output buffers
     my $data = $self->{d}->flush;
     $self->{r}->print($data);

     # print the CRC and the total length (uncompressed)
     $self->{r}->print(pack("LL",@{$self}{qw/crc l/}));
  }

  1;

Here's the Apache configuration entry you'll need to make use of it.  Once
set it will result in everything in the /compressed directory will be
compressed automagically.

  <Location /compressed>
     SetHandler  perl-script
     PerlHandler Apache::GZip
  </Location>

Although at first sight there seems to be quite a lot going on in
C<Apache::GZip>, you could sum up what the code was doing as follows --
read the contents of the file in C<< $r->filename >>, compress it and write
the compressed data to standard output. That's all.

This code has to jump through a few hoops to achieve this because

=over

=item 1.

The gzip support in C<Compress::Zlib> version 1.x can only work with a real
filesystem filehandle. The filehandles used by Apache modules are not
associated with the filesystem.

=item 2.

That means all the gzip support has to be done by hand - in this case by
creating a tied filehandle to deal with creating the gzip header and
trailer.

=back

C<IO::Compress::Gzip> doesn't have that filehandle limitation (this was one
of the reasons for writing it in the first place). So if
C<IO::Compress::Gzip> is used instead of C<Compress::Zlib> the whole tied
filehandle code can be removed. Here is the rewritten code.

  package Apache::GZip;

  use strict vars;
  use Apache::Constants ':common';
  use IO::Compress::Gzip;
  use IO::File;

  sub handler {
      my $r = shift;
      my ($fh,$gz);
      my $file = $r->filename;
      return DECLINED unless $fh=IO::File->new($file);
      $r->header_out('Content-Encoding'=>'gzip');
      $r->send_http_header;
      return OK if $r->header_only;

      my $gz = IO::Compress::Gzip->new( '-', Minimal => 1 )
          or return DECLINED ;

      print $gz $_ while <$fh>;

      return OK;
  }

or even more succinctly, like this, using a one-shot gzip

  package Apache::GZip;

  use strict vars;
  use Apache::Constants ':common';
  use IO::Compress::Gzip qw(gzip);

  sub handler {
      my $r = shift;
      $r->header_out('Content-Encoding'=>'gzip');
      $r->send_http_header;
      return OK if $r->header_only;

      gzip $r->filename => '-', Minimal => 1
        or return DECLINED ;

      return OK;
  }

  1;

The use of one-shot C<gzip> above just reads from C<< $r->filename >> and
writes the compressed data to standard output.

Note the use of the C<Minimal> option in the code above. When using gzip
for Content-Encoding you should I<always> use this option. In the example
above it will prevent the filename being included in the gzip header and
make the size of the gzip data stream a slight bit smaller.

=head2 Compressed files and Net::FTP

The C<Net::FTP> module provides two low-level methods called C<stor> and
C<retr> that both return filehandles. These filehandles can used with the
C<IO::Compress/Uncompress> modules to compress or uncompress files read
from or written to an FTP Server on the fly, without having to create a
temporary file.

Firstly, here is code that uses C<retr> to uncompressed a file as it is
read from the FTP Server.

    use Net::FTP;
    use IO::Uncompress::Gunzip qw(:all);

    my $ftp = Net::FTP->new( ... )

    my $retr_fh = $ftp->retr($compressed_filename);
    gunzip $retr_fh => $outFilename, AutoClose => 1
        or die "Cannot uncompress '$compressed_file': $GunzipError\n";

and this to compress a file as it is written to the FTP Server

    use Net::FTP;
    use IO::Compress::Gzip qw(:all);

    my $stor_fh = $ftp->stor($filename);
    gzip "filename" => $stor_fh, AutoClose => 1
        or die "Cannot compress '$filename': $GzipError\n";

=head1 MISC

=head2 Using C<InputLength> to uncompress data embedded in a larger file/buffer.

A fairly common use-case is where compressed data is embedded in a larger
file/buffer and you want to read both.

As an example consider the structure of a zip file. This is a well-defined
file format that mixes both compressed and uncompressed sections of data in
a single file.

For the purposes of this discussion you can think of a zip file as sequence
of compressed data streams, each of which is prefixed by an uncompressed
local header. The local header contains information about the compressed
data stream, including the name of the compressed file and, in particular,
the length of the compressed data stream.

To illustrate how to use C<InputLength> here is a script that walks a zip
file and prints out how many lines are in each compressed file (if you
intend write code to walking through a zip file for real see
L<IO::Uncompress::Unzip/"Walking through a zip file"> ). Also, although
this example uses the zlib-based compression, the technique can be used by
the other C<IO::Uncompress::*> modules.

    use strict;
    use warnings;

    use IO::File;
    use IO::Uncompress::RawInflate qw(:all);

    use constant ZIP_LOCAL_HDR_SIG  => 0x04034b50;
    use constant ZIP_LOCAL_HDR_LENGTH => 30;

    my $file = $ARGV[0] ;

    my $fh = IO::File->new( "<$file" )
                or die "Cannot open '$file': $!\n";

    while (1)
    {
        my $sig;
        my $buffer;

        my $x ;
        ($x = $fh->read($buffer, ZIP_LOCAL_HDR_LENGTH)) == ZIP_LOCAL_HDR_LENGTH
            or die "Truncated file: $!\n";

        my $signature = unpack ("V", substr($buffer, 0, 4));

        last unless $signature == ZIP_LOCAL_HDR_SIG;

        # Read Local Header
        my $gpFlag             = unpack ("v", substr($buffer, 6, 2));
        my $compressedMethod   = unpack ("v", substr($buffer, 8, 2));
        my $compressedLength   = unpack ("V", substr($buffer, 18, 4));
        my $uncompressedLength = unpack ("V", substr($buffer, 22, 4));
        my $filename_length    = unpack ("v", substr($buffer, 26, 2));
        my $extra_length       = unpack ("v", substr($buffer, 28, 2));

        my $filename ;
        $fh->read($filename, $filename_length) == $filename_length
            or die "Truncated file\n";

        $fh->read($buffer, $extra_length) == $extra_length
            or die "Truncated file\n";

        if ($compressedMethod != 8 && $compressedMethod != 0)
        {
            warn "Skipping file '$filename' - not deflated $compressedMethod\n";
            $fh->read($buffer, $compressedLength) == $compressedLength
                or die "Truncated file\n";
            next;
        }

        if ($compressedMethod == 0 && $gpFlag & 8 == 8)
        {
            die "Streamed Stored not supported for '$filename'\n";
        }

        next if $compressedLength == 0;

        # Done reading the Local Header

        my $inf = IO::Uncompress::RawInflate->new( $fh,
                            Transparent => 1,
                            InputLength => $compressedLength )
          or die "Cannot uncompress $file [$filename]: $RawInflateError\n"  ;

        my $line_count = 0;

        while (<$inf>)
        {
            ++ $line_count;
        }

        print "$filename: $line_count\n";
    }

The majority of the code above is concerned with reading the zip local
header data. The code that I want to focus on is at the bottom.

    while (1) {

        # read local zip header data
        # get $filename
        # get $compressedLength

        my $inf = IO::Uncompress::RawInflate->new( $fh,
                            Transparent => 1,
                            InputLength => $compressedLength )
          or die "Cannot uncompress $file [$filename]: $RawInflateError\n"  ;

        my $line_count = 0;

        while (<$inf>)
        {
            ++ $line_count;
        }

        print "$filename: $line_count\n";
    }

The call to C<IO::Uncompress::RawInflate> creates a new filehandle C<$inf>
that can be used to read from the parent filehandle C<$fh>, uncompressing
it as it goes. The use of the C<InputLength> option will guarantee that
I<at most> C<$compressedLength> bytes of compressed data will be read from
the C<$fh> filehandle (The only exception is for an error case like a
truncated file or a corrupt data stream).

This means that once RawInflate is finished C<$fh> will be left at the
byte directly after the compressed data stream.

Now consider what the code looks like without C<InputLength>

    while (1) {

        # read local zip header data
        # get $filename
        # get $compressedLength

        # read all the compressed data into $data
        read($fh, $data, $compressedLength);

        my $inf = IO::Uncompress::RawInflate->new( \$data,
                            Transparent => 1 )
          or die "Cannot uncompress $file [$filename]: $RawInflateError\n"  ;

        my $line_count = 0;

        while (<$inf>)
        {
            ++ $line_count;
        }

        print "$filename: $line_count\n";
    }

The difference here is the addition of the temporary variable C<$data>.
This is used to store a copy of the compressed data while it is being
uncompressed.

If you know that C<$compressedLength> isn't that big then using temporary
storage won't be a problem. But if C<$compressedLength> is very large or
you are writing an application that other people will use, and so have no
idea how big C<$compressedLength> will be, it could be an issue.

Using C<InputLength> avoids the use of temporary storage and means the
application can cope with large compressed data streams.

One final point -- obviously C<InputLength> can only be used whenever you
know the length of the compressed data beforehand, like here with a zip
file.

=head1 SUPPORT

General feedback/questions/bug reports should be sent to
L<https://github.com/pmqs//issues> (preferred) or
L<https://rt.cpan.org/Public/Dist/Display.html?Name=>.

=head1 SEE ALSO

L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzip>, L<IO::Uncompress::UnLzip>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Compress::Zstd>, L<IO::Uncompress::UnZstd>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>

L<IO::Compress::FAQ|IO::Compress::FAQ>

L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>,
L<Archive::Tar|Archive::Tar>,
L<IO::Zlib|IO::Zlib>

=head1 AUTHOR

This module was written by Paul Marquess, C<pmqs@cpan.org>.

=head1 MODIFICATION HISTORY

See the Changes file.

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2005-2021 Paul Marquess. All rights reserved.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           Compress/Base.pm                                                                                    0000644                 00000056730 00000000000 0007523 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       
package IO::Compress::Base ;

require 5.006 ;

use strict ;
use warnings;

use IO::Compress::Base::Common 2.101 ;

use IO::File (); ;
use Scalar::Util ();

#use File::Glob;
#require Exporter ;
use Carp() ;
use Symbol();
#use bytes;

our (@ISA, $VERSION);
@ISA    = qw(IO::File Exporter);

$VERSION = '2.102';

#Can't locate object method "SWASHNEW" via package "utf8" (perhaps you forgot to load "utf8"?) at .../ext/Compress-Zlib/Gzip/blib/lib/Compress/Zlib/Common.pm line 16.

sub saveStatus
{
    my $self   = shift ;
    ${ *$self->{ErrorNo} } = shift() + 0 ;
    ${ *$self->{Error} } = '' ;

    return ${ *$self->{ErrorNo} } ;
}


sub saveErrorString
{
    my $self   = shift ;
    my $retval = shift ;
    ${ *$self->{Error} } = shift ;
    ${ *$self->{ErrorNo} } = shift() + 0 if @_ ;

    return $retval;
}

sub croakError
{
    my $self   = shift ;
    $self->saveErrorString(0, $_[0]);
    Carp::croak $_[0];
}

sub closeError
{
    my $self = shift ;
    my $retval = shift ;

    my $errno = *$self->{ErrorNo};
    my $error = ${ *$self->{Error} };

    $self->close();

    *$self->{ErrorNo} = $errno ;
    ${ *$self->{Error} } = $error ;

    return $retval;
}



sub error
{
    my $self   = shift ;
    return ${ *$self->{Error} } ;
}

sub errorNo
{
    my $self   = shift ;
    return ${ *$self->{ErrorNo} } ;
}


sub writeAt
{
    my $self = shift ;
    my $offset = shift;
    my $data = shift;

    if (defined *$self->{FH}) {
        my $here = tell(*$self->{FH});
        return $self->saveErrorString(undef, "Cannot seek to end of output filehandle: $!", $!)
            if $here < 0 ;
        seek(*$self->{FH}, $offset, IO::Handle::SEEK_SET)
            or return $self->saveErrorString(undef, "Cannot seek to end of output filehandle: $!", $!) ;
        defined *$self->{FH}->write($data, length $data)
            or return $self->saveErrorString(undef, $!, $!) ;
        seek(*$self->{FH}, $here, IO::Handle::SEEK_SET)
            or return $self->saveErrorString(undef, "Cannot seek to end of output filehandle: $!", $!) ;
    }
    else {
        substr(${ *$self->{Buffer} }, $offset, length($data)) = $data ;
    }

    return 1;
}

sub outputPayload
{

    my $self = shift ;
    return $self->output(@_);
}


sub output
{
    my $self = shift ;
    my $data = shift ;
    my $last = shift ;

    return 1
        if length $data == 0 && ! $last ;

    if ( *$self->{FilterContainer} ) {
        *_ = \$data;
        &{ *$self->{FilterContainer} }();
    }

    if (length $data) {
        if ( defined *$self->{FH} ) {
                defined *$self->{FH}->write( $data, length $data )
                or return $self->saveErrorString(0, $!, $!);
        }
        else {
                ${ *$self->{Buffer} } .= $data ;
        }
    }

    return 1;
}

sub getOneShotParams
{
    return ( 'multistream' => [IO::Compress::Base::Common::Parse_boolean,   1],
           );
}

our %PARAMS = (
            # Generic Parameters
            'autoclose' => [IO::Compress::Base::Common::Parse_boolean,   0],
            'encode'    => [IO::Compress::Base::Common::Parse_any,       undef],
            'strict'    => [IO::Compress::Base::Common::Parse_boolean,   1],
            'append'    => [IO::Compress::Base::Common::Parse_boolean,   0],
            'binmodein' => [IO::Compress::Base::Common::Parse_boolean,   0],

            'filtercontainer' => [IO::Compress::Base::Common::Parse_code,  undef],
        );

sub checkParams
{
    my $self = shift ;
    my $class = shift ;

    my $got = shift || IO::Compress::Base::Parameters::new();

    $got->parse(
        {
            %PARAMS,


            $self->getExtraParams(),
            *$self->{OneShot} ? $self->getOneShotParams()
                              : (),
        },
        @_) or $self->croakError("${class}: " . $got->getError())  ;

    return $got ;
}

sub _create
{
    my $obj = shift;
    my $got = shift;

    *$obj->{Closed} = 1 ;

    my $class = ref $obj;
    $obj->croakError("$class: Missing Output parameter")
        if ! @_ && ! $got ;

    my $outValue = shift ;
    my $oneShot = 1 ;

    if (! $got)
    {
        $oneShot = 0 ;
        $got = $obj->checkParams($class, undef, @_)
            or return undef ;
    }

    my $lax = ! $got->getValue('strict') ;

    my $outType = IO::Compress::Base::Common::whatIsOutput($outValue);

    $obj->ckOutputParam($class, $outValue)
        or return undef ;

    if ($outType eq 'buffer') {
        *$obj->{Buffer} = $outValue;
    }
    else {
        my $buff = "" ;
        *$obj->{Buffer} = \$buff ;
    }

    # Merge implies Append
    my $merge = $got->getValue('merge') ;
    my $appendOutput = $got->getValue('append') || $merge ;
    *$obj->{Append} = $appendOutput;
    *$obj->{FilterContainer} = $got->getValue('filtercontainer') ;

    if ($merge)
    {
        # Switch off Merge mode if output file/buffer is empty/doesn't exist
        if (($outType eq 'buffer' && length $$outValue == 0 ) ||
            ($outType ne 'buffer' && (! -e $outValue || (-w _ && -z _))) )
          { $merge = 0 }
    }

    # If output is a file, check that it is writable
    #no warnings;
    #if ($outType eq 'filename' && -e $outValue && ! -w _)
    #  { return $obj->saveErrorString(undef, "Output file '$outValue' is not writable" ) }

    $obj->ckParams($got)
        or $obj->croakError("${class}: " . $obj->error());

    if ($got->getValue('encode')) {
        my $want_encoding = $got->getValue('encode');
        *$obj->{Encoding} = IO::Compress::Base::Common::getEncoding($obj, $class, $want_encoding);
        my $x = *$obj->{Encoding};
    }
    else {
        *$obj->{Encoding} = undef;
    }

    $obj->saveStatus(STATUS_OK) ;

    my $status ;
    if (! $merge)
    {
        *$obj->{Compress} = $obj->mkComp($got)
            or return undef;

        *$obj->{UnCompSize} = U64->new;
        *$obj->{CompSize} = U64->new;

        if ( $outType eq 'buffer') {
            ${ *$obj->{Buffer} }  = ''
                unless $appendOutput ;
        }
        else {
            if ($outType eq 'handle') {
                *$obj->{FH} = $outValue ;
                setBinModeOutput(*$obj->{FH}) ;
                #$outValue->flush() ;
                *$obj->{Handle} = 1 ;
                if ($appendOutput)
                {
                    seek(*$obj->{FH}, 0, IO::Handle::SEEK_END)
                        or return $obj->saveErrorString(undef, "Cannot seek to end of output filehandle: $!", $!) ;

                }
            }
            elsif ($outType eq 'filename') {
                no warnings;
                my $mode = '>' ;
                $mode = '>>'
                    if $appendOutput;
                *$obj->{FH} = IO::File->new( "$mode $outValue" )
                    or return $obj->saveErrorString(undef, "cannot open file '$outValue': $!", $!) ;
                *$obj->{StdIO} = ($outValue eq '-');
                setBinModeOutput(*$obj->{FH}) ;
            }
        }

        *$obj->{Header} = $obj->mkHeader($got) ;
        $obj->output( *$obj->{Header} )
            or return undef;
        $obj->beforePayload();
    }
    else
    {
        *$obj->{Compress} = $obj->createMerge($outValue, $outType)
            or return undef;
    }

    *$obj->{Closed} = 0 ;
    *$obj->{AutoClose} = $got->getValue('autoclose') ;
    *$obj->{Output} = $outValue;
    *$obj->{ClassName} = $class;
    *$obj->{Got} = $got;
    *$obj->{OneShot} = 0 ;

    return $obj ;
}

sub ckOutputParam
{
    my $self = shift ;
    my $from = shift ;
    my $outType = IO::Compress::Base::Common::whatIsOutput($_[0]);

    $self->croakError("$from: output parameter not a filename, filehandle or scalar ref")
        if ! $outType ;

    #$self->croakError("$from: output filename is undef or null string")
        #if $outType eq 'filename' && (! defined $_[0] || $_[0] eq '')  ;

    $self->croakError("$from: output buffer is read-only")
        if $outType eq 'buffer' && Scalar::Util::readonly(${ $_[0] });

    return 1;
}


sub _def
{
    my $obj = shift ;

    my $class= (caller)[0] ;
    my $name = (caller(1))[3] ;

    $obj->croakError("$name: expected at least 1 parameters\n")
        unless @_ >= 1 ;

    my $input = shift ;
    my $haveOut = @_ ;
    my $output = shift ;

    my $x = IO::Compress::Base::Validator->new($class, *$obj->{Error}, $name, $input, $output)
        or return undef ;

    push @_, $output if $haveOut && $x->{Hash};

    *$obj->{OneShot} = 1 ;

    my $got = $obj->checkParams($name, undef, @_)
        or return undef ;

    $x->{Got} = $got ;

#    if ($x->{Hash})
#    {
#        while (my($k, $v) = each %$input)
#        {
#            $v = \$input->{$k}
#                unless defined $v ;
#
#            $obj->_singleTarget($x, 1, $k, $v, @_)
#                or return undef ;
#        }
#
#        return keys %$input ;
#    }

    if ($x->{GlobMap})
    {
        $x->{oneInput} = 1 ;
        foreach my $pair (@{ $x->{Pairs} })
        {
            my ($from, $to) = @$pair ;
            $obj->_singleTarget($x, 1, $from, $to, @_)
                or return undef ;
        }

        return scalar @{ $x->{Pairs} } ;
    }

    if (! $x->{oneOutput} )
    {
        my $inFile = ($x->{inType} eq 'filenames'
                        || $x->{inType} eq 'filename');

        $x->{inType} = $inFile ? 'filename' : 'buffer';

        foreach my $in ($x->{oneInput} ? $input : @$input)
        {
            my $out ;
            $x->{oneInput} = 1 ;

            $obj->_singleTarget($x, $inFile, $in, \$out, @_)
                or return undef ;

            push @$output, \$out ;
            #if ($x->{outType} eq 'array')
            #  { push @$output, \$out }
            #else
            #  { $output->{$in} = \$out }
        }

        return 1 ;
    }

    # finally the 1 to 1 and n to 1
    return $obj->_singleTarget($x, 1, $input, $output, @_);

    Carp::croak "should not be here" ;
}

sub _singleTarget
{
    my $obj             = shift ;
    my $x               = shift ;
    my $inputIsFilename = shift;
    my $input           = shift;

    if ($x->{oneInput})
    {
        $obj->getFileInfo($x->{Got}, $input)
            if isaScalar($input) || (isaFilename($input) and $inputIsFilename) ;

        my $z = $obj->_create($x->{Got}, @_)
            or return undef ;


        defined $z->_wr2($input, $inputIsFilename)
            or return $z->closeError(undef) ;

        return $z->close() ;
    }
    else
    {
        my $afterFirst = 0 ;
        my $inputIsFilename = ($x->{inType} ne 'array');
        my $keep = $x->{Got}->clone();

        #for my $element ( ($x->{inType} eq 'hash') ? keys %$input : @$input)
        for my $element ( @$input)
        {
            my $isFilename = isaFilename($element);

            if ( $afterFirst ++ )
            {
                defined addInterStream($obj, $element, $isFilename)
                    or return $obj->closeError(undef) ;
            }
            else
            {
                $obj->getFileInfo($x->{Got}, $element)
                    if isaScalar($element) || $isFilename;

                $obj->_create($x->{Got}, @_)
                    or return undef ;
            }

            defined $obj->_wr2($element, $isFilename)
                or return $obj->closeError(undef) ;

            *$obj->{Got} = $keep->clone();
        }
        return $obj->close() ;
    }

}

sub _wr2
{
    my $self = shift ;

    my $source = shift ;
    my $inputIsFilename = shift;

    my $input = $source ;
    if (! $inputIsFilename)
    {
        $input = \$source
            if ! ref $source;
    }

    if ( ref $input && ref $input eq 'SCALAR' )
    {
        return $self->syswrite($input, @_) ;
    }

    if ( ! ref $input  || isaFilehandle($input))
    {
        my $isFilehandle = isaFilehandle($input) ;

        my $fh = $input ;

        if ( ! $isFilehandle )
        {
            $fh = IO::File->new( "<$input" )
                or return $self->saveErrorString(undef, "cannot open file '$input': $!", $!) ;
        }
        binmode $fh ;

        my $status ;
        my $buff ;
        my $count = 0 ;
        while ($status = read($fh, $buff, 16 * 1024)) {
            $count += length $buff;
            defined $self->syswrite($buff, @_)
                or return undef ;
        }

        return $self->saveErrorString(undef, $!, $!)
            if ! defined $status ;

        if ( (!$isFilehandle || *$self->{AutoClose}) && $input ne '-')
        {
            $fh->close()
                or return undef ;
        }

        return $count ;
    }

    Carp::croak "Should not be here";
    return undef;
}

sub addInterStream
{
    my $self = shift ;
    my $input = shift ;
    my $inputIsFilename = shift ;

    if (*$self->{Got}->getValue('multistream'))
    {
        $self->getFileInfo(*$self->{Got}, $input)
            #if isaFilename($input) and $inputIsFilename ;
            if isaScalar($input) || isaFilename($input) ;

        # TODO -- newStream needs to allow gzip/zip header to be modified
        return $self->newStream();
    }
    elsif (*$self->{Got}->getValue('autoflush'))
    {
        #return $self->flush(Z_FULL_FLUSH);
    }

    return 1 ;
}

sub getFileInfo
{
}

sub TIEHANDLE
{
    return $_[0] if ref($_[0]);
    die "OOPS\n" ;
}

sub UNTIE
{
    my $self = shift ;
}

sub DESTROY
{
    my $self = shift ;
    local ($., $@, $!, $^E, $?);

    $self->close() ;

    # TODO - memory leak with 5.8.0 - this isn't called until
    #        global destruction
    #
    %{ *$self } = () ;
    undef $self ;
}



sub filterUncompressed
{
}

sub syswrite
{
    my $self = shift ;

    my $buffer ;
    if (ref $_[0] ) {
        $self->croakError( *$self->{ClassName} . "::write: not a scalar reference" )
            unless ref $_[0] eq 'SCALAR' ;
        $buffer = $_[0] ;
    }
    else {
        $buffer = \$_[0] ;
    }

    if (@_ > 1) {
        my $slen = defined $$buffer ? length($$buffer) : 0;
        my $len = $slen;
        my $offset = 0;
        $len = $_[1] if $_[1] < $len;

        if (@_ > 2) {
            $offset = $_[2] || 0;
            $self->croakError(*$self->{ClassName} . "::write: offset outside string")
                if $offset > $slen;
            if ($offset < 0) {
                $offset += $slen;
                $self->croakError( *$self->{ClassName} . "::write: offset outside string") if $offset < 0;
            }
            my $rem = $slen - $offset;
            $len = $rem if $rem < $len;
        }

        $buffer = \substr($$buffer, $offset, $len) ;
    }

    return 0 if (! defined $$buffer || length $$buffer == 0) && ! *$self->{FlushPending};

#    *$self->{Pending} .= $$buffer ;
#
#    return length $$buffer
#        if (length *$self->{Pending} < 1024 * 16 && ! *$self->{FlushPending}) ;
#
#    $$buffer = *$self->{Pending} ;
#    *$self->{Pending} = '';

    if (*$self->{Encoding}) {
        $$buffer = *$self->{Encoding}->encode($$buffer);
    }
    else {
        $] >= 5.008 and ( utf8::downgrade($$buffer, 1)
            or Carp::croak "Wide character in " .  *$self->{ClassName} . "::write:");
    }

    $self->filterUncompressed($buffer);

    my $buffer_length = defined $$buffer ? length($$buffer) : 0 ;
    *$self->{UnCompSize}->add($buffer_length) ;

    my $outBuffer='';
    my $status = *$self->{Compress}->compr($buffer, $outBuffer) ;

    return $self->saveErrorString(undef, *$self->{Compress}{Error},
                                         *$self->{Compress}{ErrorNo})
        if $status == STATUS_ERROR;

    *$self->{CompSize}->add(length $outBuffer) ;

    $self->outputPayload($outBuffer)
        or return undef;

    return $buffer_length;
}

sub print
{
    my $self = shift;

    #if (ref $self) {
    #    $self = *$self{GLOB} ;
    #}

    if (defined $\) {
        if (defined $,) {
            defined $self->syswrite(join($,, @_) . $\);
        } else {
            defined $self->syswrite(join("", @_) . $\);
        }
    } else {
        if (defined $,) {
            defined $self->syswrite(join($,, @_));
        } else {
            defined $self->syswrite(join("", @_));
        }
    }
}

sub printf
{
    my $self = shift;
    my $fmt = shift;
    defined $self->syswrite(sprintf($fmt, @_));
}

sub _flushCompressed
{
    my $self = shift ;

    my $outBuffer='';
    my $status = *$self->{Compress}->flush($outBuffer, @_) ;
    return $self->saveErrorString(0, *$self->{Compress}{Error},
                                    *$self->{Compress}{ErrorNo})
        if $status == STATUS_ERROR;

    if ( defined *$self->{FH} ) {
        *$self->{FH}->clearerr();
    }

    *$self->{CompSize}->add(length $outBuffer) ;

    $self->outputPayload($outBuffer)
        or return 0;
    return 1;
}

sub flush
{
    my $self = shift ;

    $self->_flushCompressed(@_)
        or return 0;

    if ( defined *$self->{FH} ) {
        defined *$self->{FH}->flush()
            or return $self->saveErrorString(0, $!, $!);
    }

    return 1;
}

sub beforePayload
{
}

sub _newStream
{
    my $self = shift ;
    my $got  = shift;

    my $class = ref $self;

    $self->_writeTrailer()
        or return 0 ;

    $self->ckParams($got)
        or $self->croakError("newStream: $self->{Error}");

    if ($got->getValue('encode')) {
        my $want_encoding = $got->getValue('encode');
        *$self->{Encoding} = IO::Compress::Base::Common::getEncoding($self, $class, $want_encoding);
    }
    else {
        *$self->{Encoding} = undef;
    }

    *$self->{Compress} = $self->mkComp($got)
        or return 0;

    *$self->{Header} = $self->mkHeader($got) ;
    $self->output(*$self->{Header} )
        or return 0;

    *$self->{UnCompSize}->reset();
    *$self->{CompSize}->reset();

    $self->beforePayload();

    return 1 ;
}

sub newStream
{
    my $self = shift ;

    my $got = $self->checkParams('newStream', *$self->{Got}, @_)
        or return 0 ;

    $self->_newStream($got);

#    *$self->{Compress} = $self->mkComp($got)
#        or return 0;
#
#    *$self->{Header} = $self->mkHeader($got) ;
#    $self->output(*$self->{Header} )
#        or return 0;
#
#    *$self->{UnCompSize}->reset();
#    *$self->{CompSize}->reset();
#
#    $self->beforePayload();
#
#    return 1 ;
}

sub reset
{
    my $self = shift ;
    return *$self->{Compress}->reset() ;
}

sub _writeTrailer
{
    my $self = shift ;

    my $trailer = '';

    my $status = *$self->{Compress}->close($trailer) ;

    return $self->saveErrorString(0, *$self->{Compress}{Error}, *$self->{Compress}{ErrorNo})
        if $status == STATUS_ERROR;

    *$self->{CompSize}->add(length $trailer) ;

    $trailer .= $self->mkTrailer();
    defined $trailer
      or return 0;
    return $self->output($trailer);
}

sub _writeFinalTrailer
{
    my $self = shift ;

    return $self->output($self->mkFinalTrailer());
}

sub close
{
    my $self = shift ;
    return 1 if *$self->{Closed} || ! *$self->{Compress} ;
    *$self->{Closed} = 1 ;

    untie *$self
        if $] >= 5.008 ;

    *$self->{FlushPending} = 1 ;
    $self->_writeTrailer()
        or return 0 ;

    $self->_writeFinalTrailer()
        or return 0 ;

    $self->output( "", 1 )
        or return 0;

    if (defined *$self->{FH}) {

        if ((! *$self->{Handle} || *$self->{AutoClose}) && ! *$self->{StdIO}) {
            $! = 0 ;
            *$self->{FH}->close()
                or return $self->saveErrorString(0, $!, $!);
        }
        delete *$self->{FH} ;
        # This delete can set $! in older Perls, so reset the errno
        $! = 0 ;
    }

    return 1;
}


#sub total_in
#sub total_out
#sub msg
#
#sub crc
#{
#    my $self = shift ;
#    return *$self->{Compress}->crc32() ;
#}
#
#sub msg
#{
#    my $self = shift ;
#    return *$self->{Compress}->msg() ;
#}
#
#sub dict_adler
#{
#    my $self = shift ;
#    return *$self->{Compress}->dict_adler() ;
#}
#
#sub get_Level
#{
#    my $self = shift ;
#    return *$self->{Compress}->get_Level() ;
#}
#
#sub get_Strategy
#{
#    my $self = shift ;
#    return *$self->{Compress}->get_Strategy() ;
#}


sub tell
{
    my $self = shift ;

    return *$self->{UnCompSize}->get32bit() ;
}

sub eof
{
    my $self = shift ;

    return *$self->{Closed} ;
}


sub seek
{
    my $self     = shift ;
    my $position = shift;
    my $whence   = shift ;

    my $here = $self->tell() ;
    my $target = 0 ;

    #use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END);
    use IO::Handle ;

    if ($whence == IO::Handle::SEEK_SET) {
        $target = $position ;
    }
    elsif ($whence == IO::Handle::SEEK_CUR || $whence == IO::Handle::SEEK_END) {
        $target = $here + $position ;
    }
    else {
        $self->croakError(*$self->{ClassName} . "::seek: unknown value, $whence, for whence parameter");
    }

    # short circuit if seeking to current offset
    return 1 if $target == $here ;

    # Outlaw any attempt to seek backwards
    $self->croakError(*$self->{ClassName} . "::seek: cannot seek backwards")
        if $target < $here ;

    # Walk the file to the new offset
    my $offset = $target - $here ;

    my $buffer ;
    defined $self->syswrite("\x00" x $offset)
        or return 0;

    return 1 ;
}

sub binmode
{
    1;
#    my $self     = shift ;
#    return defined *$self->{FH}
#            ? binmode *$self->{FH}
#            : 1 ;
}

sub fileno
{
    my $self     = shift ;
    return defined *$self->{FH}
            ? *$self->{FH}->fileno()
            : undef ;
}

sub opened
{
    my $self     = shift ;
    return ! *$self->{Closed} ;
}

sub autoflush
{
    my $self     = shift ;
    return defined *$self->{FH}
            ? *$self->{FH}->autoflush(@_)
            : undef ;
}

sub input_line_number
{
    return undef ;
}


sub _notAvailable
{
    my $name = shift ;
    return sub { Carp::croak "$name Not Available: File opened only for output" ; } ;
}

{
    no warnings 'once';

    *read     = _notAvailable('read');
    *READ     = _notAvailable('read');
    *readline = _notAvailable('readline');
    *READLINE = _notAvailable('readline');
    *getc     = _notAvailable('getc');
    *GETC     = _notAvailable('getc');

    *FILENO   = \&fileno;
    *PRINT    = \&print;
    *PRINTF   = \&printf;
    *WRITE    = \&syswrite;
    *write    = \&syswrite;
    *SEEK     = \&seek;
    *TELL     = \&tell;
    *EOF      = \&eof;
    *CLOSE    = \&close;
    *BINMODE  = \&binmode;
}

#*sysread  = \&_notAvailable;
#*syswrite = \&_write;

1;

__END__

=head1 NAME

IO::Compress::Base - Base Class for IO::Compress modules

=head1 SYNOPSIS

    use IO::Compress::Base ;

=head1 DESCRIPTION

This module is not intended for direct use in application code. Its sole
purpose is to be sub-classed by IO::Compress modules.

=head1 SUPPORT

General feedback/questions/bug reports should be sent to
L<https://github.com/pmqs/IO-Compress/issues> (preferred) or
L<https://rt.cpan.org/Public/Dist/Display.html?Name=IO-Compress>.

=head1 SEE ALSO

L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzip>, L<IO::Uncompress::UnLzip>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Compress::Zstd>, L<IO::Uncompress::UnZstd>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>

L<IO::Compress::FAQ|IO::Compress::FAQ>

L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>,
L<Archive::Tar|Archive::Tar>,
L<IO::Zlib|IO::Zlib>

=head1 AUTHOR

This module was written by Paul Marquess, C<pmqs@cpan.org>.

=head1 MODIFICATION HISTORY

See the Changes file.

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2005-2021 Paul Marquess. All rights reserved.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
                                        Compress/Base/Common.pm                                                                             0000644                 00000054366 00000000000 0010756 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       package IO::Compress::Base::Common;

use strict ;
use warnings;
use bytes;

use Carp;
use Scalar::Util qw(blessed readonly);
use File::GlobMapper;

require Exporter;
our ($VERSION, @ISA, @EXPORT, %EXPORT_TAGS, $HAS_ENCODE);
@ISA = qw(Exporter);
$VERSION = '2.102';

@EXPORT = qw( isaFilehandle isaFilename isaScalar
              whatIsInput whatIsOutput
              isaFileGlobString cleanFileGlobString oneTarget
              setBinModeInput setBinModeOutput
              ckInOutParams
              createSelfTiedObject

              isGeMax32

              MAX32

              WANT_CODE
              WANT_EXT
              WANT_UNDEF
              WANT_HASH

              STATUS_OK
              STATUS_ENDSTREAM
              STATUS_EOF
              STATUS_ERROR
          );

%EXPORT_TAGS = ( Status => [qw( STATUS_OK
                                 STATUS_ENDSTREAM
                                 STATUS_EOF
                                 STATUS_ERROR
                           )]);


use constant STATUS_OK        => 0;
use constant STATUS_ENDSTREAM => 1;
use constant STATUS_EOF       => 2;
use constant STATUS_ERROR     => -1;
use constant MAX16            => 0xFFFF ;
use constant MAX32            => 0xFFFFFFFF ;
use constant MAX32cmp         => 0xFFFFFFFF + 1 - 1; # for 5.6.x on 32-bit need to force an non-IV value


sub isGeMax32
{
    return $_[0] >= MAX32cmp ;
}

sub hasEncode()
{
    if (! defined $HAS_ENCODE) {
        eval
        {
            require Encode;
            Encode->import();
        };

        $HAS_ENCODE = $@ ? 0 : 1 ;
    }

    return $HAS_ENCODE;
}

sub getEncoding($$$)
{
    my $obj = shift;
    my $class = shift ;
    my $want_encoding = shift ;

    $obj->croakError("$class: Encode module needed to use -Encode")
        if ! hasEncode();

    my $encoding = Encode::find_encoding($want_encoding);

    $obj->croakError("$class: Encoding '$want_encoding' is not available")
       if ! $encoding;

    return $encoding;
}

our ($needBinmode);
$needBinmode = ($^O eq 'MSWin32' ||
                    ($] >= 5.006 && eval ' ${^UNICODE} || ${^UTF8LOCALE} '))
                    ? 1 : 1 ;

sub setBinModeInput($)
{
    my $handle = shift ;

    binmode $handle
        if  $needBinmode;
}

sub setBinModeOutput($)
{
    my $handle = shift ;

    binmode $handle
        if  $needBinmode;
}

sub isaFilehandle($)
{
    use utf8; # Pragma needed to keep Perl 5.6.0 happy
    return (defined $_[0] and
             (UNIVERSAL::isa($_[0],'GLOB') or
              UNIVERSAL::isa($_[0],'IO::Handle') or
              UNIVERSAL::isa(\$_[0],'GLOB'))
          )
}

sub isaScalar
{
    return ( defined($_[0]) and ref($_[0]) eq 'SCALAR' and defined ${ $_[0] } ) ;
}

sub isaFilename($)
{
    return (defined $_[0] and
           ! ref $_[0]    and
           UNIVERSAL::isa(\$_[0], 'SCALAR'));
}

sub isaFileGlobString
{
    return defined $_[0] && $_[0] =~ /^<.*>$/;
}

sub cleanFileGlobString
{
    my $string = shift ;

    $string =~ s/^\s*<\s*(.*)\s*>\s*$/$1/;

    return $string;
}

use constant WANT_CODE  => 1 ;
use constant WANT_EXT   => 2 ;
use constant WANT_UNDEF => 4 ;
#use constant WANT_HASH  => 8 ;
use constant WANT_HASH  => 0 ;

sub whatIsInput($;$)
{
    my $got = whatIs(@_);

    if (defined $got && $got eq 'filename' && defined $_[0] && $_[0] eq '-')
    {
        #use IO::File;
        $got = 'handle';
        $_[0] = *STDIN;
        #$_[0] = IO::File->new("<-");
    }

    return $got;
}

sub whatIsOutput($;$)
{
    my $got = whatIs(@_);

    if (defined $got && $got eq 'filename' && defined $_[0] && $_[0] eq '-')
    {
        $got = 'handle';
        $_[0] = *STDOUT;
        #$_[0] = IO::File->new(">-");
    }

    return $got;
}

sub whatIs ($;$)
{
    return 'handle' if isaFilehandle($_[0]);

    my $wantCode = defined $_[1] && $_[1] & WANT_CODE ;
    my $extended = defined $_[1] && $_[1] & WANT_EXT ;
    my $undef    = defined $_[1] && $_[1] & WANT_UNDEF ;
    my $hash     = defined $_[1] && $_[1] & WANT_HASH ;

    return 'undef'  if ! defined $_[0] && $undef ;

    if (ref $_[0]) {
        return ''       if blessed($_[0]); # is an object
        #return ''       if UNIVERSAL::isa($_[0], 'UNIVERSAL'); # is an object
        return 'buffer' if UNIVERSAL::isa($_[0], 'SCALAR');
        return 'array'  if UNIVERSAL::isa($_[0], 'ARRAY')  && $extended ;
        return 'hash'   if UNIVERSAL::isa($_[0], 'HASH')   && $hash ;
        return 'code'   if UNIVERSAL::isa($_[0], 'CODE')   && $wantCode ;
        return '';
    }

    return 'fileglob' if $extended && isaFileGlobString($_[0]);
    return 'filename';
}

sub oneTarget
{
    return $_[0] =~ /^(code|handle|buffer|filename)$/;
}

sub IO::Compress::Base::Validator::new
{
    my $class = shift ;

    my $Class = shift ;
    my $error_ref = shift ;
    my $reportClass = shift ;

    my %data = (Class       => $Class,
                Error       => $error_ref,
                reportClass => $reportClass,
               ) ;

    my $obj = bless \%data, $class ;

    local $Carp::CarpLevel = 1;

    my $inType    = $data{inType}    = whatIsInput($_[0], WANT_EXT|WANT_HASH);
    my $outType   = $data{outType}   = whatIsOutput($_[1], WANT_EXT|WANT_HASH);

    my $oneInput  = $data{oneInput}  = oneTarget($inType);
    my $oneOutput = $data{oneOutput} = oneTarget($outType);

    if (! $inType)
    {
        $obj->croakError("$reportClass: illegal input parameter") ;
        #return undef ;
    }

#    if ($inType eq 'hash')
#    {
#        $obj->{Hash} = 1 ;
#        $obj->{oneInput} = 1 ;
#        return $obj->validateHash($_[0]);
#    }

    if (! $outType)
    {
        $obj->croakError("$reportClass: illegal output parameter") ;
        #return undef ;
    }


    if ($inType ne 'fileglob' && $outType eq 'fileglob')
    {
        $obj->croakError("Need input fileglob for outout fileglob");
    }

#    if ($inType ne 'fileglob' && $outType eq 'hash' && $inType ne 'filename' )
#    {
#        $obj->croakError("input must ne filename or fileglob when output is a hash");
#    }

    if ($inType eq 'fileglob' && $outType eq 'fileglob')
    {
        $data{GlobMap} = 1 ;
        $data{inType} = $data{outType} = 'filename';
        my $mapper = File::GlobMapper->new($_[0], $_[1]);
        if ( ! $mapper )
        {
            return $obj->saveErrorString($File::GlobMapper::Error) ;
        }
        $data{Pairs} = $mapper->getFileMap();

        return $obj;
    }

    $obj->croakError("$reportClass: input and output $inType are identical")
        if $inType eq $outType && $_[0] eq $_[1] && $_[0] ne '-' ;

    if ($inType eq 'fileglob') # && $outType ne 'fileglob'
    {
        my $glob = cleanFileGlobString($_[0]);
        my @inputs = glob($glob);

        if (@inputs == 0)
        {
            # TODO -- legal or die?
            die "globmap matched zero file -- legal or die???" ;
        }
        elsif (@inputs == 1)
        {
            $obj->validateInputFilenames($inputs[0])
                or return undef;
            $_[0] = $inputs[0]  ;
            $data{inType} = 'filename' ;
            $data{oneInput} = 1;
        }
        else
        {
            $obj->validateInputFilenames(@inputs)
                or return undef;
            $_[0] = [ @inputs ] ;
            $data{inType} = 'filenames' ;
        }
    }
    elsif ($inType eq 'filename')
    {
        $obj->validateInputFilenames($_[0])
            or return undef;
    }
    elsif ($inType eq 'array')
    {
        $data{inType} = 'filenames' ;
        $obj->validateInputArray($_[0])
            or return undef ;
    }

    return $obj->saveErrorString("$reportClass: output buffer is read-only")
        if $outType eq 'buffer' && readonly(${ $_[1] });

    if ($outType eq 'filename' )
    {
        $obj->croakError("$reportClass: output filename is undef or null string")
            if ! defined $_[1] || $_[1] eq ''  ;

        if (-e $_[1])
        {
            if (-d _ )
            {
                return $obj->saveErrorString("output file '$_[1]' is a directory");
            }
        }
    }

    return $obj ;
}

sub IO::Compress::Base::Validator::saveErrorString
{
    my $self   = shift ;
    ${ $self->{Error} } = shift ;
    return undef;

}

sub IO::Compress::Base::Validator::croakError
{
    my $self   = shift ;
    $self->saveErrorString($_[0]);
    croak $_[0];
}



sub IO::Compress::Base::Validator::validateInputFilenames
{
    my $self = shift ;

    foreach my $filename (@_)
    {
        $self->croakError("$self->{reportClass}: input filename is undef or null string")
            if ! defined $filename || $filename eq ''  ;

        next if $filename eq '-';

        if (! -e $filename )
        {
            return $self->saveErrorString("input file '$filename' does not exist");
        }

        if (-d _ )
        {
            return $self->saveErrorString("input file '$filename' is a directory");
        }

#        if (! -r _ )
#        {
#            return $self->saveErrorString("cannot open file '$filename': $!");
#        }
    }

    return 1 ;
}

sub IO::Compress::Base::Validator::validateInputArray
{
    my $self = shift ;

    if ( @{ $_[0] } == 0 )
    {
        return $self->saveErrorString("empty array reference") ;
    }

    foreach my $element ( @{ $_[0] } )
    {
        my $inType  = whatIsInput($element);

        if (! $inType)
        {
            $self->croakError("unknown input parameter") ;
        }
        elsif($inType eq 'filename')
        {
            $self->validateInputFilenames($element)
                or return undef ;
        }
        else
        {
            $self->croakError("not a filename") ;
        }
    }

    return 1 ;
}

#sub IO::Compress::Base::Validator::validateHash
#{
#    my $self = shift ;
#    my $href = shift ;
#
#    while (my($k, $v) = each %$href)
#    {
#        my $ktype = whatIsInput($k);
#        my $vtype = whatIsOutput($v, WANT_EXT|WANT_UNDEF) ;
#
#        if ($ktype ne 'filename')
#        {
#            return $self->saveErrorString("hash key not filename") ;
#        }
#
#        my %valid = map { $_ => 1 } qw(filename buffer array undef handle) ;
#        if (! $valid{$vtype})
#        {
#            return $self->saveErrorString("hash value not ok") ;
#        }
#    }
#
#    return $self ;
#}

sub createSelfTiedObject
{
    my $class = shift || (caller)[0] ;
    my $error_ref = shift ;

    my $obj = bless Symbol::gensym(), ref($class) || $class;
    tie *$obj, $obj if $] >= 5.005;
    *$obj->{Closed} = 1 ;
    $$error_ref = '';
    *$obj->{Error} = $error_ref ;
    my $errno = 0 ;
    *$obj->{ErrorNo} = \$errno ;

    return $obj;
}



#package Parse::Parameters ;
#
#
#require Exporter;
#our ($VERSION, @ISA, @EXPORT);
#$VERSION = '2.000_08';
#@ISA = qw(Exporter);

$EXPORT_TAGS{Parse} = [qw( ParseParameters
                           Parse_any Parse_unsigned Parse_signed
                           Parse_boolean Parse_string
                           Parse_code
                           Parse_writable_scalar
                         )
                      ];

push @EXPORT, @{ $EXPORT_TAGS{Parse} } ;

use constant Parse_any      => 0x01;
use constant Parse_unsigned => 0x02;
use constant Parse_signed   => 0x04;
use constant Parse_boolean  => 0x08;
use constant Parse_string   => 0x10;
use constant Parse_code     => 0x20;

#use constant Parse_store_ref        => 0x100 ;
#use constant Parse_multiple         => 0x100 ;
use constant Parse_writable         => 0x200 ;
use constant Parse_writable_scalar  => 0x400 | Parse_writable ;

use constant OFF_PARSED     => 0 ;
use constant OFF_TYPE       => 1 ;
use constant OFF_DEFAULT    => 2 ;
use constant OFF_FIXED      => 3 ;
#use constant OFF_FIRST_ONLY => 4 ;
#use constant OFF_STICKY     => 5 ;

use constant IxError => 0;
use constant IxGot   => 1 ;

sub ParseParameters
{
    my $level = shift || 0 ;

    my $sub = (caller($level + 1))[3] ;
    local $Carp::CarpLevel = 1 ;

    return $_[1]
        if @_ == 2 && defined $_[1] && UNIVERSAL::isa($_[1], "IO::Compress::Base::Parameters");

    my $p = IO::Compress::Base::Parameters->new();
    $p->parse(@_)
        or croak "$sub: $p->[IxError]" ;

    return $p;
}


use strict;

use warnings;
use Carp;


sub Init
{
    my $default = shift ;
    my %got ;

    my $obj = IO::Compress::Base::Parameters::new();
    while (my ($key, $v) = each %$default)
    {
        croak "need 2 params [@$v]"
            if @$v != 2 ;

        my ($type, $value) = @$v ;
#        my ($first_only, $sticky, $type, $value) = @$v ;
        my $sticky = 0;
        my $x ;
        $obj->_checkType($key, \$value, $type, 0, \$x)
            or return undef ;

        $key = lc $key;

#        if (! $sticky) {
#            $x = []
#                if $type & Parse_multiple;

#            $got{$key} = [0, $type, $value, $x, $first_only, $sticky] ;
            $got{$key} = [0, $type, $value, $x] ;
#        }
#
#        $got{$key}[OFF_PARSED] = 0 ;
    }

    return bless \%got, "IO::Compress::Base::Parameters::Defaults" ;
}

sub IO::Compress::Base::Parameters::new
{
    #my $class = shift ;

    my $obj;
    $obj->[IxError] = '';
    $obj->[IxGot] = {} ;

    return bless $obj, 'IO::Compress::Base::Parameters' ;
}

sub IO::Compress::Base::Parameters::setError
{
    my $self = shift ;
    my $error = shift ;
    my $retval = @_ ? shift : undef ;


    $self->[IxError] = $error ;
    return $retval;
}

sub IO::Compress::Base::Parameters::getError
{
    my $self = shift ;
    return $self->[IxError] ;
}

sub IO::Compress::Base::Parameters::parse
{
    my $self = shift ;
    my $default = shift ;

    my $got = $self->[IxGot] ;
    my $firstTime = keys %{ $got } == 0 ;

    my (@Bad) ;
    my @entered = () ;

    # Allow the options to be passed as a hash reference or
    # as the complete hash.
    if (@_ == 0) {
        @entered = () ;
    }
    elsif (@_ == 1) {
        my $href = $_[0] ;

        return $self->setError("Expected even number of parameters, got 1")
            if ! defined $href or ! ref $href or ref $href ne "HASH" ;

        foreach my $key (keys %$href) {
            push @entered, $key ;
            push @entered, \$href->{$key} ;
        }
    }
    else {

        my $count = @_;
        return $self->setError("Expected even number of parameters, got $count")
            if $count % 2 != 0 ;

        for my $i (0.. $count / 2 - 1) {
            push @entered, $_[2 * $i] ;
            push @entered, \$_[2 * $i + 1] ;
        }
    }

        foreach my $key (keys %$default)
        {

            my ($type, $value) = @{ $default->{$key} } ;

            if ($firstTime) {
                $got->{$key} = [0, $type, $value, $value] ;
            }
            else
            {
                $got->{$key}[OFF_PARSED] = 0 ;
            }
        }


    my %parsed = ();


    for my $i (0.. @entered / 2 - 1) {
        my $key = $entered[2* $i] ;
        my $value = $entered[2* $i+1] ;

        #print "Key [$key] Value [$value]" ;
        #print defined $$value ? "[$$value]\n" : "[undef]\n";

        $key =~ s/^-// ;
        my $canonkey = lc $key;

        if ($got->{$canonkey})
        {
            my $type = $got->{$canonkey}[OFF_TYPE] ;
            my $parsed = $parsed{$canonkey};
            ++ $parsed{$canonkey};

            return $self->setError("Muliple instances of '$key' found")
                if $parsed ;

            my $s ;
            $self->_checkType($key, $value, $type, 1, \$s)
                or return undef ;

            $value = $$value ;
            $got->{$canonkey} = [1, $type, $value, $s] ;

        }
        else
          { push (@Bad, $key) }
    }

    if (@Bad) {
        my ($bad) = join(", ", @Bad) ;
        return $self->setError("unknown key value(s) $bad") ;
    }

    return 1;
}

sub IO::Compress::Base::Parameters::_checkType
{
    my $self = shift ;

    my $key   = shift ;
    my $value = shift ;
    my $type  = shift ;
    my $validate  = shift ;
    my $output  = shift;

    #local $Carp::CarpLevel = $level ;
    #print "PARSE $type $key $value $validate $sub\n" ;

    if ($type & Parse_writable_scalar)
    {
        return $self->setError("Parameter '$key' not writable")
            if  readonly $$value ;

        if (ref $$value)
        {
            return $self->setError("Parameter '$key' not a scalar reference")
                if ref $$value ne 'SCALAR' ;

            $$output = $$value ;
        }
        else
        {
            return $self->setError("Parameter '$key' not a scalar")
                if ref $value ne 'SCALAR' ;

            $$output = $value ;
        }

        return 1;
    }


    $value = $$value ;

    if ($type & Parse_any)
    {
        $$output = $value ;
        return 1;
    }
    elsif ($type & Parse_unsigned)
    {

        return $self->setError("Parameter '$key' must be an unsigned int, got 'undef'")
            if ! defined $value ;
        return $self->setError("Parameter '$key' must be an unsigned int, got '$value'")
            if $value !~ /^\d+$/;

        $$output = defined $value ? $value : 0 ;
        return 1;
    }
    elsif ($type & Parse_signed)
    {
        return $self->setError("Parameter '$key' must be a signed int, got 'undef'")
            if ! defined $value ;
        return $self->setError("Parameter '$key' must be a signed int, got '$value'")
            if $value !~ /^-?\d+$/;

        $$output = defined $value ? $value : 0 ;
        return 1 ;
    }
    elsif ($type & Parse_boolean)
    {
        return $self->setError("Parameter '$key' must be an int, got '$value'")
            if defined $value && $value !~ /^\d*$/;

        $$output =  defined $value && $value != 0 ? 1 : 0 ;
        return 1;
    }

    elsif ($type & Parse_string)
    {
        $$output = defined $value ? $value : "" ;
        return 1;
    }
    elsif ($type & Parse_code)
    {
        return $self->setError("Parameter '$key' must be a code reference, got '$value'")
            if (! defined $value || ref $value ne 'CODE') ;

        $$output = defined $value ? $value : "" ;
        return 1;
    }

    $$output = $value ;
    return 1;
}

sub IO::Compress::Base::Parameters::parsed
{
    return $_[0]->[IxGot]{$_[1]}[OFF_PARSED] ;
}


sub IO::Compress::Base::Parameters::getValue
{
    return  $_[0]->[IxGot]{$_[1]}[OFF_FIXED] ;
}
sub IO::Compress::Base::Parameters::setValue
{
    $_[0]->[IxGot]{$_[1]}[OFF_PARSED]  = 1;
    $_[0]->[IxGot]{$_[1]}[OFF_DEFAULT] = $_[2] ;
    $_[0]->[IxGot]{$_[1]}[OFF_FIXED]   = $_[2] ;
}

sub IO::Compress::Base::Parameters::valueRef
{
    return  $_[0]->[IxGot]{$_[1]}[OFF_FIXED]  ;
}

sub IO::Compress::Base::Parameters::valueOrDefault
{
    my $self = shift ;
    my $name = shift ;
    my $default = shift ;

    my $value = $self->[IxGot]{$name}[OFF_DEFAULT] ;

    return $value if defined $value ;
    return $default ;
}

sub IO::Compress::Base::Parameters::wantValue
{
    return defined $_[0]->[IxGot]{$_[1]}[OFF_DEFAULT] ;
}

sub IO::Compress::Base::Parameters::clone
{
    my $self = shift ;
    my $obj = [] ;
    my %got ;

    my $hash = $self->[IxGot] ;
    for my $k (keys %{ $hash })
    {
        $got{$k} = [ @{ $hash->{$k} } ];
    }

    $obj->[IxError] = $self->[IxError];
    $obj->[IxGot] = \%got ;

    return bless $obj, 'IO::Compress::Base::Parameters' ;
}

package U64;

use constant MAX32 => 0xFFFFFFFF ;
use constant HI_1 => MAX32 + 1 ;
use constant LOW   => 0 ;
use constant HIGH  => 1;

sub new
{
    return bless [ 0, 0 ], $_[0]
        if @_ == 1 ;

    return bless [ $_[1], 0 ], $_[0]
        if @_ == 2 ;

    return bless [ $_[2], $_[1] ], $_[0]
        if @_ == 3 ;
}

sub newUnpack_V64
{
    my ($low, $hi) = unpack "V V", $_[0] ;
    bless [ $low, $hi ], "U64";
}

sub newUnpack_V32
{
    my $string = shift;

    my $low = unpack "V", $string ;
    bless [ $low, 0 ], "U64";
}

sub reset
{
    $_[0]->[HIGH] = $_[0]->[LOW] = 0;
}

sub clone
{
    bless [ @{$_[0]}  ], ref $_[0] ;
}

sub getHigh
{
    return $_[0]->[HIGH];
}

sub getLow
{
    return $_[0]->[LOW];
}

sub get32bit
{
    return $_[0]->[LOW];
}

sub get64bit
{
    # Not using << here because the result will still be
    # a 32-bit value on systems where int size is 32-bits
    return $_[0]->[HIGH] * HI_1 + $_[0]->[LOW];
}

sub add
{
#    my $self = shift;
    my $value = $_[1];

    if (ref $value eq 'U64') {
        $_[0]->[HIGH] += $value->[HIGH] ;
        $value = $value->[LOW];
    }
    elsif ($value > MAX32) {
        $_[0]->[HIGH] += int($value / HI_1) ;
        $value = $value % HI_1;
    }

    my $available = MAX32 - $_[0]->[LOW] ;

    if ($value > $available) {
       ++ $_[0]->[HIGH] ;
       $_[0]->[LOW] = $value - $available - 1;
    }
    else {
       $_[0]->[LOW] += $value ;
    }
}

sub add32
{
#    my $self = shift;
    my $value = $_[1];

    if ($value > MAX32) {
        $_[0]->[HIGH] += int($value / HI_1) ;
        $value = $value % HI_1;
    }

    my $available = MAX32 - $_[0]->[LOW] ;

    if ($value > $available) {
       ++ $_[0]->[HIGH] ;
       $_[0]->[LOW] = $value - $available - 1;
    }
    else {
       $_[0]->[LOW] += $value ;
    }
}

sub subtract
{
    my $self = shift;
    my $value = shift;

    if (ref $value eq 'U64') {

        if ($value->[HIGH]) {
            die "bad"
                if $self->[HIGH] == 0 ||
                   $value->[HIGH] > $self->[HIGH] ;

           $self->[HIGH] -= $value->[HIGH] ;
        }

        $value = $value->[LOW] ;
    }

    if ($value > $self->[LOW]) {
       -- $self->[HIGH] ;
       $self->[LOW] = MAX32 - $value + $self->[LOW] + 1 ;
    }
    else {
       $self->[LOW] -= $value;
    }
}

sub equal
{
    my $self = shift;
    my $other = shift;

    return $self->[LOW]  == $other->[LOW] &&
           $self->[HIGH] == $other->[HIGH] ;
}

sub isZero
{
    my $self = shift;

    return $self->[LOW]  == 0 &&
           $self->[HIGH] == 0 ;
}

sub gt
{
    my $self = shift;
    my $other = shift;

    return $self->cmp($other) > 0 ;
}

sub cmp
{
    my $self = shift;
    my $other = shift ;

    if ($self->[LOW] == $other->[LOW]) {
        return $self->[HIGH] - $other->[HIGH] ;
    }
    else {
        return $self->[LOW] - $other->[LOW] ;
    }
}


sub is64bit
{
    return $_[0]->[HIGH] > 0 ;
}

sub isAlmost64bit
{
    return $_[0]->[HIGH] > 0 ||  $_[0]->[LOW] == MAX32 ;
}

sub getPacked_V64
{
    return pack "V V", @{ $_[0] } ;
}

sub getPacked_V32
{
    return pack "V", $_[0]->[LOW] ;
}

sub pack_V64
{
    return pack "V V", $_[0], 0;
}


sub full32
{
    return $_[0] == MAX32 ;
}

sub Value_VV64
{
    my $buffer = shift;

    my ($lo, $hi) = unpack ("V V" , $buffer);
    no warnings 'uninitialized';
    return $hi * HI_1 + $lo;
}


package IO::Compress::Base::Common;

1;
                                                                                                                                                                                                                                                                          Compress/Zlib/Constants.pm                                                                          0000644                 00000003171 00000000000 0011514 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       
package IO::Compress::Zlib::Constants ;

use strict ;
use warnings;
use bytes;

require Exporter;

our ($VERSION, @ISA, @EXPORT);

$VERSION = '2.102';

@ISA = qw(Exporter);

@EXPORT= qw(

        ZLIB_HEADER_SIZE
        ZLIB_TRAILER_SIZE

        ZLIB_CMF_CM_OFFSET
        ZLIB_CMF_CM_BITS
        ZLIB_CMF_CM_DEFLATED

        ZLIB_CMF_CINFO_OFFSET
        ZLIB_CMF_CINFO_BITS
        ZLIB_CMF_CINFO_MAX

        ZLIB_FLG_FCHECK_OFFSET
        ZLIB_FLG_FCHECK_BITS

        ZLIB_FLG_FDICT_OFFSET
        ZLIB_FLG_FDICT_BITS

        ZLIB_FLG_LEVEL_OFFSET
        ZLIB_FLG_LEVEL_BITS

        ZLIB_FLG_LEVEL_FASTEST
        ZLIB_FLG_LEVEL_FAST
        ZLIB_FLG_LEVEL_DEFAULT
        ZLIB_FLG_LEVEL_SLOWEST

        ZLIB_FDICT_SIZE

        );

# Constant names derived from RFC1950

use constant ZLIB_HEADER_SIZE       => 2;
use constant ZLIB_TRAILER_SIZE      => 4;

use constant ZLIB_CMF_CM_OFFSET     => 0;
use constant ZLIB_CMF_CM_BITS       => 0xF ; # 0b1111
use constant ZLIB_CMF_CM_DEFLATED   => 8;

use constant ZLIB_CMF_CINFO_OFFSET  => 4;
use constant ZLIB_CMF_CINFO_BITS    => 0xF ; # 0b1111;
use constant ZLIB_CMF_CINFO_MAX     => 7;

use constant ZLIB_FLG_FCHECK_OFFSET => 0;
use constant ZLIB_FLG_FCHECK_BITS   => 0x1F ; # 0b11111;

use constant ZLIB_FLG_FDICT_OFFSET  => 5;
use constant ZLIB_FLG_FDICT_BITS    => 0x1 ; # 0b1;

use constant ZLIB_FLG_LEVEL_OFFSET  => 6;
use constant ZLIB_FLG_LEVEL_BITS    => 0x3 ; # 0b11;

use constant ZLIB_FLG_LEVEL_FASTEST => 0;
use constant ZLIB_FLG_LEVEL_FAST    => 1;
use constant ZLIB_FLG_LEVEL_DEFAULT => 2;
use constant ZLIB_FLG_LEVEL_SLOWEST => 3;

use constant ZLIB_FDICT_SIZE        => 4;


1;
                                                                                                                                                                                                                                                                                                                                                                                                       Compress/Zlib/Extra.pm                                                                              0000644                 00000013017 00000000000 0010623 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       package IO::Compress::Zlib::Extra;

require 5.006 ;

use strict ;
use warnings;
use bytes;

our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS);

$VERSION = '2.102';

use IO::Compress::Gzip::Constants 2.101 ;

sub ExtraFieldError
{
    return $_[0];
    return "Error with ExtraField Parameter: $_[0]" ;
}

sub validateExtraFieldPair
{
    my $pair = shift ;
    my $strict = shift;
    my $gzipMode = shift ;

    return ExtraFieldError("Not an array ref")
        unless ref $pair &&  ref $pair eq 'ARRAY';

    return ExtraFieldError("SubField must have two parts")
        unless @$pair == 2 ;

    return ExtraFieldError("SubField ID is a reference")
        if ref $pair->[0] ;

    return ExtraFieldError("SubField Data is a reference")
        if ref $pair->[1] ;

    # ID is exactly two chars
    return ExtraFieldError("SubField ID not two chars long")
        unless length $pair->[0] == GZIP_FEXTRA_SUBFIELD_ID_SIZE ;

    # Check that the 2nd byte of the ID isn't 0
    return ExtraFieldError("SubField ID 2nd byte is 0x00")
        if $strict && $gzipMode && substr($pair->[0], 1, 1) eq "\x00" ;

    return ExtraFieldError("SubField Data too long")
        if length $pair->[1] > GZIP_FEXTRA_SUBFIELD_MAX_SIZE ;


    return undef ;
}

sub parseRawExtra
{
    my $data     = shift ;
    my $extraRef = shift;
    my $strict   = shift;
    my $gzipMode = shift ;

    #my $lax = shift ;

    #return undef
    #    if $lax ;

    my $XLEN = length $data ;

    return ExtraFieldError("Too Large")
        if $XLEN > GZIP_FEXTRA_MAX_SIZE;

    my $offset = 0 ;
    while ($offset < $XLEN) {

        return ExtraFieldError("Truncated in FEXTRA Body Section")
            if $offset + GZIP_FEXTRA_SUBFIELD_HEADER_SIZE  > $XLEN ;

        my $id = substr($data, $offset, GZIP_FEXTRA_SUBFIELD_ID_SIZE);
        $offset += GZIP_FEXTRA_SUBFIELD_ID_SIZE;

        my $subLen =  unpack("v", substr($data, $offset,
                                            GZIP_FEXTRA_SUBFIELD_LEN_SIZE));
        $offset += GZIP_FEXTRA_SUBFIELD_LEN_SIZE ;

        return ExtraFieldError("Truncated in FEXTRA Body Section")
            if $offset + $subLen > $XLEN ;

        my $bad = validateExtraFieldPair( [$id,
                                           substr($data, $offset, $subLen)],
                                           $strict, $gzipMode );
        return $bad if $bad ;
        push @$extraRef, [$id => substr($data, $offset, $subLen)]
            if defined $extraRef;;

        $offset += $subLen ;
    }


    return undef ;
}

sub findID
{
    my $id_want = shift ;
    my $data    = shift;

    my $XLEN = length $data ;

    my $offset = 0 ;
    while ($offset < $XLEN) {

        return undef
            if $offset + GZIP_FEXTRA_SUBFIELD_HEADER_SIZE  > $XLEN ;

        my $id = substr($data, $offset, GZIP_FEXTRA_SUBFIELD_ID_SIZE);
        $offset += GZIP_FEXTRA_SUBFIELD_ID_SIZE;

        my $subLen =  unpack("v", substr($data, $offset,
                                            GZIP_FEXTRA_SUBFIELD_LEN_SIZE));
        $offset += GZIP_FEXTRA_SUBFIELD_LEN_SIZE ;

        return undef
            if $offset + $subLen > $XLEN ;

        return substr($data, $offset, $subLen)
            if $id eq $id_want ;

        $offset += $subLen ;
    }

    return undef ;
}


sub mkSubField
{
    my $id = shift ;
    my $data = shift ;

    return $id . pack("v", length $data) . $data ;
}

sub parseExtraField
{
    my $dataRef  = $_[0];
    my $strict   = $_[1];
    my $gzipMode = $_[2];
    #my $lax     = @_ == 2 ? $_[1] : 1;


    # ExtraField can be any of
    #
    #    -ExtraField => $data
    #
    #    -ExtraField => [$id1, $data1,
    #                    $id2, $data2]
    #                     ...
    #                   ]
    #
    #    -ExtraField => [ [$id1 => $data1],
    #                     [$id2 => $data2],
    #                     ...
    #                   ]
    #
    #    -ExtraField => { $id1 => $data1,
    #                     $id2 => $data2,
    #                     ...
    #                   }

    if ( ! ref $dataRef ) {

        return undef
            if ! $strict;

        return parseRawExtra($dataRef, undef, 1, $gzipMode);
    }

    my $data = $dataRef;
    my $out = '' ;

    if (ref $data eq 'ARRAY') {
        if (ref $data->[0]) {

            foreach my $pair (@$data) {
                return ExtraFieldError("Not list of lists")
                    unless ref $pair eq 'ARRAY' ;

                my $bad = validateExtraFieldPair($pair, $strict, $gzipMode) ;
                return $bad if $bad ;

                $out .= mkSubField(@$pair);
            }
        }
        else {
            return ExtraFieldError("Not even number of elements")
                unless @$data % 2  == 0;

            for (my $ix = 0; $ix <= @$data -1 ; $ix += 2) {
                my $bad = validateExtraFieldPair([$data->[$ix],
                                                  $data->[$ix+1]],
                                                 $strict, $gzipMode) ;
                return $bad if $bad ;

                $out .= mkSubField($data->[$ix], $data->[$ix+1]);
            }
        }
    }
    elsif (ref $data eq 'HASH') {
        while (my ($id, $info) = each %$data) {
            my $bad = validateExtraFieldPair([$id, $info], $strict, $gzipMode);
            return $bad if $bad ;

            $out .= mkSubField($id, $info);
        }
    }
    else {
        return ExtraFieldError("Not a scalar, array ref or hash ref") ;
    }

    return ExtraFieldError("Too Large")
        if length $out > GZIP_FEXTRA_MAX_SIZE;

    $_[0] = $out ;

    return undef;
}

1;

__END__
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 Compress/Bzip2.pm                                                                                   0000644                 00000051471 00000000000 0007634 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       package IO::Compress::Bzip2 ;

use strict ;
use warnings;
use bytes;
require Exporter ;

use IO::Compress::Base 2.101 ;

use IO::Compress::Base::Common  2.101 qw();
use IO::Compress::Adapter::Bzip2 2.101 ;



our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $Bzip2Error);

$VERSION = '2.102';
$Bzip2Error = '';

@ISA    = qw(IO::Compress::Base Exporter);
@EXPORT_OK = qw( $Bzip2Error bzip2 ) ;
%EXPORT_TAGS = %IO::Compress::Base::EXPORT_TAGS ;
push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
Exporter::export_ok_tags('all');



sub new
{
    my $class = shift ;

    my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$Bzip2Error);
    return $obj->_create(undef, @_);
}

sub bzip2
{
    my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$Bzip2Error);
    $obj->_def(@_);
}


sub mkHeader
{
    my $self = shift ;
    return '';

}

sub getExtraParams
{
    my $self = shift ;

    use IO::Compress::Base::Common  2.101 qw(:Parse);

    return (
            'blocksize100k' => [IO::Compress::Base::Common::Parse_unsigned,  1],
            'workfactor'    => [IO::Compress::Base::Common::Parse_unsigned,  0],
            'verbosity'     => [IO::Compress::Base::Common::Parse_boolean,   0],
        );
}



sub ckParams
{
    my $self = shift ;
    my $got = shift;

    # check that BlockSize100K is a number between 1 & 9
    if ($got->parsed('blocksize100k')) {
        my $value = $got->getValue('blocksize100k');
        return $self->saveErrorString(undef, "Parameter 'BlockSize100K' not between 1 and 9, got $value")
            unless defined $value && $value >= 1 && $value <= 9;

    }

    # check that WorkFactor between 0 & 250
    if ($got->parsed('workfactor')) {
        my $value = $got->getValue('workfactor');
        return $self->saveErrorString(undef, "Parameter 'WorkFactor' not between 0 and 250, got $value")
            unless $value >= 0 && $value <= 250;
    }

    return 1 ;
}


sub mkComp
{
    my $self = shift ;
    my $got = shift ;

    my $BlockSize100K = $got->getValue('blocksize100k');
    my $WorkFactor    = $got->getValue('workfactor');
    my $Verbosity     = $got->getValue('verbosity');

    my ($obj, $errstr, $errno) = IO::Compress::Adapter::Bzip2::mkCompObject(
                                               $BlockSize100K, $WorkFactor,
                                               $Verbosity);

    return $self->saveErrorString(undef, $errstr, $errno)
        if ! defined $obj;

    return $obj;
}


sub mkTrailer
{
    my $self = shift ;
    return '';
}

sub mkFinalTrailer
{
    return '';
}

#sub newHeader
#{
#    my $self = shift ;
#    return '';
#}

sub getInverseClass
{
    return ('IO::Uncompress::Bunzip2');
}

sub getFileInfo
{
    my $self = shift ;
    my $params = shift;
    my $file = shift ;

}

1;

__END__

=head1 NAME

IO::Compress::Bzip2 - Write bzip2 files/buffers

=head1 SYNOPSIS

    use IO::Compress::Bzip2 qw(bzip2 $Bzip2Error) ;

    my $status = bzip2 $input => $output [,OPTS]
        or die "bzip2 failed: $Bzip2Error\n";

    my $z = IO::Compress::Bzip2->new( $output [,OPTS] )
        or die "bzip2 failed: $Bzip2Error\n";

    $z->print($string);
    $z->printf($format, $string);
    $z->write($string);
    $z->syswrite($string [, $length, $offset]);
    $z->flush();
    $z->tell();
    $z->eof();
    $z->seek($position, $whence);
    $z->binmode();
    $z->fileno();
    $z->opened();
    $z->autoflush();
    $z->input_line_number();
    $z->newStream( [OPTS] );

    $z->close() ;

    $Bzip2Error ;

    # IO::File mode

    print $z $string;
    printf $z $format, $string;
    tell $z
    eof $z
    seek $z, $position, $whence
    binmode $z
    fileno $z
    close $z ;

=head1 DESCRIPTION

This module provides a Perl interface that allows writing bzip2
compressed data to files or buffer.

For reading bzip2 files/buffers, see the companion module
L<IO::Uncompress::Bunzip2|IO::Uncompress::Bunzip2>.

=head1 Functional Interface

A top-level function, C<bzip2>, is provided to carry out
"one-shot" compression between buffers and/or files. For finer
control over the compression process, see the L</"OO Interface">
section.

    use IO::Compress::Bzip2 qw(bzip2 $Bzip2Error) ;

    bzip2 $input_filename_or_reference => $output_filename_or_reference [,OPTS]
        or die "bzip2 failed: $Bzip2Error\n";

The functional interface needs Perl5.005 or better.

=head2 bzip2 $input_filename_or_reference => $output_filename_or_reference [, OPTS]

C<bzip2> expects at least two parameters,
C<$input_filename_or_reference> and C<$output_filename_or_reference>
and zero or more optional parameters (see L</Optional Parameters>)

=head3 The C<$input_filename_or_reference> parameter

The parameter, C<$input_filename_or_reference>, is used to define the
source of the uncompressed data.

It can take one of the following forms:

=over 5

=item A filename

If the C<$input_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename. This file will be opened for reading and the
input data will be read from it.

=item A filehandle

If the C<$input_filename_or_reference> parameter is a filehandle, the input
data will be read from it.  The string '-' can be used as an alias for
standard input.

=item A scalar reference

If C<$input_filename_or_reference> is a scalar reference, the input data
will be read from C<$$input_filename_or_reference>.

=item An array reference

If C<$input_filename_or_reference> is an array reference, each element in
the array must be a filename.

The input data will be read from each file in turn.

The complete array will be walked to ensure that it only
contains valid filenames before any data is compressed.

=item An Input FileGlob string

If C<$input_filename_or_reference> is a string that is delimited by the
characters "<" and ">" C<bzip2> will assume that it is an
I<input fileglob string>. The input is the list of files that match the
fileglob.

See L<File::GlobMapper|File::GlobMapper> for more details.

=back

If the C<$input_filename_or_reference> parameter is any other type,
C<undef> will be returned.

=head3 The C<$output_filename_or_reference> parameter

The parameter C<$output_filename_or_reference> is used to control the
destination of the compressed data. This parameter can take one of
these forms.

=over 5

=item A filename

If the C<$output_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename.  This file will be opened for writing and the
compressed data will be written to it.

=item A filehandle

If the C<$output_filename_or_reference> parameter is a filehandle, the
compressed data will be written to it.  The string '-' can be used as
an alias for standard output.

=item A scalar reference

If C<$output_filename_or_reference> is a scalar reference, the
compressed data will be stored in C<$$output_filename_or_reference>.

=item An Array Reference

If C<$output_filename_or_reference> is an array reference,
the compressed data will be pushed onto the array.

=item An Output FileGlob

If C<$output_filename_or_reference> is a string that is delimited by the
characters "<" and ">" C<bzip2> will assume that it is an
I<output fileglob string>. The output is the list of files that match the
fileglob.

When C<$output_filename_or_reference> is an fileglob string,
C<$input_filename_or_reference> must also be a fileglob string. Anything
else is an error.

See L<File::GlobMapper|File::GlobMapper> for more details.

=back

If the C<$output_filename_or_reference> parameter is any other type,
C<undef> will be returned.

=head2 Notes

When C<$input_filename_or_reference> maps to multiple files/buffers and
C<$output_filename_or_reference> is a single
file/buffer the input files/buffers will be stored
in C<$output_filename_or_reference> as a concatenated series of compressed data streams.

=head2 Optional Parameters

The optional parameters for the one-shot function C<bzip2>
are (for the most part) identical to those used with the OO interface defined in the
L</"Constructor Options"> section. The exceptions are listed below

=over 5

=item C<< AutoClose => 0|1 >>

This option applies to any input or output data streams to
C<bzip2> that are filehandles.

If C<AutoClose> is specified, and the value is true, it will result in all
input and/or output filehandles being closed once C<bzip2> has
completed.

This parameter defaults to 0.

=item C<< BinModeIn => 0|1 >>

This option is now a no-op. All files will be read in binmode.

=item C<< Append => 0|1 >>

The behaviour of this option is dependent on the type of output data
stream.

=over 5

=item * A Buffer

If C<Append> is enabled, all compressed data will be append to the end of
the output buffer. Otherwise the output buffer will be cleared before any
compressed data is written to it.

=item * A Filename

If C<Append> is enabled, the file will be opened in append mode. Otherwise
the contents of the file, if any, will be truncated before any compressed
data is written to it.

=item * A Filehandle

If C<Append> is enabled, the filehandle will be positioned to the end of
the file via a call to C<seek> before any compressed data is
written to it.  Otherwise the file pointer will not be moved.

=back

When C<Append> is specified, and set to true, it will I<append> all compressed
data to the output data stream.

So when the output is a filehandle it will carry out a seek to the eof
before writing any compressed data. If the output is a filename, it will be opened for
appending. If the output is a buffer, all compressed data will be
appended to the existing buffer.

Conversely when C<Append> is not specified, or it is present and is set to
false, it will operate as follows.

When the output is a filename, it will truncate the contents of the file
before writing any compressed data. If the output is a filehandle
its position will not be changed. If the output is a buffer, it will be
wiped before any compressed data is output.

Defaults to 0.

=back

=head2 Examples

Here are a few example that show the capabilities of the module.

=head3 Streaming

This very simple command line example demonstrates the streaming capabilities of the module.
The code reads data from STDIN, compresses it, and writes the compressed data to STDOUT.

    $ echo hello world | perl -MIO::Compress::Bzip2=bzip2 -e 'bzip2 \*STDIN => \*STDOUT' >output.bz2

The special filename "-" can be used as a standin for both C<\*STDIN> and C<\*STDOUT>,
so the above can be rewritten as

    $ echo hello world | perl -MIO::Compress::Bzip2=bzip2 -e 'bzip2 "-" => "-"' >output.bz2

=head3 Compressing a file from the filesystem

To read the contents of the file C<file1.txt> and write the compressed
data to the file C<file1.txt.bz2>.

    use strict ;
    use warnings ;
    use IO::Compress::Bzip2 qw(bzip2 $Bzip2Error) ;

    my $input = "file1.txt";
    bzip2 $input => "$input.bz2"
        or die "bzip2 failed: $Bzip2Error\n";

=head3 Reading from a Filehandle and writing to an in-memory buffer

To read from an existing Perl filehandle, C<$input>, and write the
compressed data to a buffer, C<$buffer>.

    use strict ;
    use warnings ;
    use IO::Compress::Bzip2 qw(bzip2 $Bzip2Error) ;
    use IO::File ;

    my $input = IO::File->new( "<file1.txt" )
        or die "Cannot open 'file1.txt': $!\n" ;
    my $buffer ;
    bzip2 $input => \$buffer
        or die "bzip2 failed: $Bzip2Error\n";

=head3 Compressing multiple files

To compress all files in the directory "/my/home" that match "*.txt"
and store the compressed data in the same directory

    use strict ;
    use warnings ;
    use IO::Compress::Bzip2 qw(bzip2 $Bzip2Error) ;

    bzip2 '</my/home/*.txt>' => '<*.bz2>'
        or die "bzip2 failed: $Bzip2Error\n";

and if you want to compress each file one at a time, this will do the trick

    use strict ;
    use warnings ;
    use IO::Compress::Bzip2 qw(bzip2 $Bzip2Error) ;

    for my $input ( glob "/my/home/*.txt" )
    {
        my $output = "$input.bz2" ;
        bzip2 $input => $output
            or die "Error compressing '$input': $Bzip2Error\n";
    }

=head1 OO Interface

=head2 Constructor

The format of the constructor for C<IO::Compress::Bzip2> is shown below

    my $z = IO::Compress::Bzip2->new( $output [,OPTS] )
        or die "IO::Compress::Bzip2 failed: $Bzip2Error\n";

It returns an C<IO::Compress::Bzip2> object on success and undef on failure.
The variable C<$Bzip2Error> will contain an error message on failure.

If you are running Perl 5.005 or better the object, C<$z>, returned from
IO::Compress::Bzip2 can be used exactly like an L<IO::File|IO::File> filehandle.
This means that all normal output file operations can be carried out
with C<$z>.
For example, to write to a compressed file/buffer you can use either of
these forms

    $z->print("hello world\n");
    print $z "hello world\n";

The mandatory parameter C<$output> is used to control the destination
of the compressed data. This parameter can take one of these forms.

=over 5

=item A filename

If the C<$output> parameter is a simple scalar, it is assumed to be a
filename. This file will be opened for writing and the compressed data
will be written to it.

=item A filehandle

If the C<$output> parameter is a filehandle, the compressed data will be
written to it.
The string '-' can be used as an alias for standard output.

=item A scalar reference

If C<$output> is a scalar reference, the compressed data will be stored
in C<$$output>.

=back

If the C<$output> parameter is any other type, C<IO::Compress::Bzip2>::new will
return undef.

=head2 Constructor Options

C<OPTS> is any combination of zero or more the following options:

=over 5

=item C<< AutoClose => 0|1 >>

This option is only valid when the C<$output> parameter is a filehandle. If
specified, and the value is true, it will result in the C<$output> being
closed once either the C<close> method is called or the C<IO::Compress::Bzip2>
object is destroyed.

This parameter defaults to 0.

=item C<< Append => 0|1 >>

Opens C<$output> in append mode.

The behaviour of this option is dependent on the type of C<$output>.

=over 5

=item * A Buffer

If C<$output> is a buffer and C<Append> is enabled, all compressed data
will be append to the end of C<$output>. Otherwise C<$output> will be
cleared before any data is written to it.

=item * A Filename

If C<$output> is a filename and C<Append> is enabled, the file will be
opened in append mode. Otherwise the contents of the file, if any, will be
truncated before any compressed data is written to it.

=item * A Filehandle

If C<$output> is a filehandle, the file pointer will be positioned to the
end of the file via a call to C<seek> before any compressed data is written
to it.  Otherwise the file pointer will not be moved.

=back

This parameter defaults to 0.

=item C<< BlockSize100K => number >>

Specify the number of 100K blocks bzip2 uses during compression.

Valid values are from 1 to 9, where 9 is best compression.

The default is 1.

=item C<< WorkFactor => number >>

Specifies how much effort bzip2 should take before resorting to a slower
fallback compression algorithm.

Valid values range from 0 to 250, where 0 means use the default value 30.

The default is 0.

=item C<< Strict => 0|1 >>

This is a placeholder option.

=back

=head2 Examples

TODO

=head1 Methods

=head2 print

Usage is

    $z->print($data)
    print $z $data

Compresses and outputs the contents of the C<$data> parameter. This
has the same behaviour as the C<print> built-in.

Returns true if successful.

=head2 printf

Usage is

    $z->printf($format, $data)
    printf $z $format, $data

Compresses and outputs the contents of the C<$data> parameter.

Returns true if successful.

=head2 syswrite

Usage is

    $z->syswrite $data
    $z->syswrite $data, $length
    $z->syswrite $data, $length, $offset

Compresses and outputs the contents of the C<$data> parameter.

Returns the number of uncompressed bytes written, or C<undef> if
unsuccessful.

=head2 write

Usage is

    $z->write $data
    $z->write $data, $length
    $z->write $data, $length, $offset

Compresses and outputs the contents of the C<$data> parameter.

Returns the number of uncompressed bytes written, or C<undef> if
unsuccessful.

=head2 flush

Usage is

    $z->flush;

Flushes any pending compressed data to the output file/buffer.

TODO

Returns true on success.

=head2 tell

Usage is

    $z->tell()
    tell $z

Returns the uncompressed file offset.

=head2 eof

Usage is

    $z->eof();
    eof($z);

Returns true if the C<close> method has been called.

=head2 seek

    $z->seek($position, $whence);
    seek($z, $position, $whence);

Provides a sub-set of the C<seek> functionality, with the restriction
that it is only legal to seek forward in the output file/buffer.
It is a fatal error to attempt to seek backward.

Empty parts of the file/buffer will have NULL (0x00) bytes written to them.

The C<$whence> parameter takes one the usual values, namely SEEK_SET,
SEEK_CUR or SEEK_END.

Returns 1 on success, 0 on failure.

=head2 binmode

Usage is

    $z->binmode
    binmode $z ;

This is a noop provided for completeness.

=head2 opened

    $z->opened()

Returns true if the object currently refers to a opened file/buffer.

=head2 autoflush

    my $prev = $z->autoflush()
    my $prev = $z->autoflush(EXPR)

If the C<$z> object is associated with a file or a filehandle, this method
returns the current autoflush setting for the underlying filehandle. If
C<EXPR> is present, and is non-zero, it will enable flushing after every
write/print operation.

If C<$z> is associated with a buffer, this method has no effect and always
returns C<undef>.

B<Note> that the special variable C<$|> B<cannot> be used to set or
retrieve the autoflush setting.

=head2 input_line_number

    $z->input_line_number()
    $z->input_line_number(EXPR)

This method always returns C<undef> when compressing.

=head2 fileno

    $z->fileno()
    fileno($z)

If the C<$z> object is associated with a file or a filehandle, C<fileno>
will return the underlying file descriptor. Once the C<close> method is
called C<fileno> will return C<undef>.

If the C<$z> object is associated with a buffer, this method will return
C<undef>.

=head2 close

    $z->close() ;
    close $z ;

Flushes any pending compressed data and then closes the output file/buffer.

For most versions of Perl this method will be automatically invoked if
the IO::Compress::Bzip2 object is destroyed (either explicitly or by the
variable with the reference to the object going out of scope). The
exceptions are Perl versions 5.005 through 5.00504 and 5.8.0. In
these cases, the C<close> method will be called automatically, but
not until global destruction of all live objects when the program is
terminating.

Therefore, if you want your scripts to be able to run on all versions
of Perl, you should call C<close> explicitly and not rely on automatic
closing.

Returns true on success, otherwise 0.

If the C<AutoClose> option has been enabled when the IO::Compress::Bzip2
object was created, and the object is associated with a file, the
underlying file will also be closed.

=head2 newStream([OPTS])

Usage is

    $z->newStream( [OPTS] )

Closes the current compressed data stream and starts a new one.

OPTS consists of any of the options that are available when creating
the C<$z> object.

See the L</"Constructor Options"> section for more details.

=head1 Importing

No symbolic constants are required by IO::Compress::Bzip2 at present.

=over 5

=item :all

Imports C<bzip2> and C<$Bzip2Error>.
Same as doing this

    use IO::Compress::Bzip2 qw(bzip2 $Bzip2Error) ;

=back

=head1 EXAMPLES

=head2 Apache::GZip Revisited

See L<IO::Compress::FAQ|IO::Compress::FAQ/"Apache::GZip Revisited">

=head2 Working with Net::FTP

See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP">

=head1 SUPPORT

General feedback/questions/bug reports should be sent to
L<https://github.com/pmqs/IO-Compress/issues> (preferred) or
L<https://rt.cpan.org/Public/Dist/Display.html?Name=IO-Compress>.

=head1 SEE ALSO

L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzip>, L<IO::Uncompress::UnLzip>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Compress::Zstd>, L<IO::Uncompress::UnZstd>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>

L<IO::Compress::FAQ|IO::Compress::FAQ>

L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>,
L<Archive::Tar|Archive::Tar>,
L<IO::Zlib|IO::Zlib>

The primary site for the bzip2 program is L<https://sourceware.org/bzip2/>.

See the module L<Compress::Bzip2|Compress::Bzip2>

=head1 AUTHOR

This module was written by Paul Marquess, C<pmqs@cpan.org>.

=head1 MODIFICATION HISTORY

See the Changes file.

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2005-2021 Paul Marquess. All rights reserved.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
                                                                                                                                                                                                       Compress/Gzip.pm                                                                                    0000644                 00000104534 00000000000 0007556 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       package IO::Compress::Gzip ;

require 5.006 ;

use strict ;
use warnings;
use bytes;

require Exporter ;

use IO::Compress::RawDeflate 2.101 () ;
use IO::Compress::Adapter::Deflate 2.101 ;

use IO::Compress::Base::Common  2.101 qw(:Status );
use IO::Compress::Gzip::Constants 2.101 ;
use IO::Compress::Zlib::Extra 2.101 ;

BEGIN
{
    if (defined &utf8::downgrade )
      { *noUTF8 = \&utf8::downgrade }
    else
      { *noUTF8 = sub {} }
}

our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $GzipError);

$VERSION = '2.102';
$GzipError = '' ;

@ISA    = qw(IO::Compress::RawDeflate Exporter);
@EXPORT_OK = qw( $GzipError gzip ) ;
%EXPORT_TAGS = %IO::Compress::RawDeflate::DEFLATE_CONSTANTS ;

push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
Exporter::export_ok_tags('all');

sub new
{
    my $class = shift ;

    my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$GzipError);

    $obj->_create(undef, @_);
}


sub gzip
{
    my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$GzipError);
    return $obj->_def(@_);
}

#sub newHeader
#{
#    my $self = shift ;
#    #return GZIP_MINIMUM_HEADER ;
#    return $self->mkHeader(*$self->{Got});
#}

sub getExtraParams
{
    my $self = shift ;

    return (
            # zlib behaviour
            $self->getZlibParams(),

            # Gzip header fields
            'minimal'   => [IO::Compress::Base::Common::Parse_boolean,   0],
            'comment'   => [IO::Compress::Base::Common::Parse_any,       undef],
            'name'      => [IO::Compress::Base::Common::Parse_any,       undef],
            'time'      => [IO::Compress::Base::Common::Parse_any,       undef],
            'textflag'  => [IO::Compress::Base::Common::Parse_boolean,   0],
            'headercrc' => [IO::Compress::Base::Common::Parse_boolean,   0],
            'os_code'   => [IO::Compress::Base::Common::Parse_unsigned,  $Compress::Raw::Zlib::gzip_os_code],
            'extrafield'=> [IO::Compress::Base::Common::Parse_any,       undef],
            'extraflags'=> [IO::Compress::Base::Common::Parse_any,       undef],

        );
}


sub ckParams
{
    my $self = shift ;
    my $got = shift ;

    # gzip always needs crc32
    $got->setValue('crc32' => 1);

    return 1
        if $got->getValue('merge') ;

    my $strict = $got->getValue('strict') ;


    {
        if (! $got->parsed('time') ) {
            # Modification time defaults to now.
            $got->setValue(time => time) ;
        }

        # Check that the Name & Comment don't have embedded NULLs
        # Also check that they only contain ISO 8859-1 chars.
        if ($got->parsed('name') && defined $got->getValue('name')) {
            my $name = $got->getValue('name');

            return $self->saveErrorString(undef, "Null Character found in Name",
                                                Z_DATA_ERROR)
                if $strict && $name =~ /\x00/ ;

            return $self->saveErrorString(undef, "Non ISO 8859-1 Character found in Name",
                                                Z_DATA_ERROR)
                if $strict && $name =~ /$GZIP_FNAME_INVALID_CHAR_RE/o ;
        }

        if ($got->parsed('comment') && defined $got->getValue('comment')) {
            my $comment = $got->getValue('comment');

            return $self->saveErrorString(undef, "Null Character found in Comment",
                                                Z_DATA_ERROR)
                if $strict && $comment =~ /\x00/ ;

            return $self->saveErrorString(undef, "Non ISO 8859-1 Character found in Comment",
                                                Z_DATA_ERROR)
                if $strict && $comment =~ /$GZIP_FCOMMENT_INVALID_CHAR_RE/o;
        }

        if ($got->parsed('os_code') ) {
            my $value = $got->getValue('os_code');

            return $self->saveErrorString(undef, "OS_Code must be between 0 and 255, got '$value'")
                if $value < 0 || $value > 255 ;

        }

        # gzip only supports Deflate at present
        $got->setValue('method' => Z_DEFLATED) ;

        if ( ! $got->parsed('extraflags')) {
            $got->setValue('extraflags' => 2)
                if $got->getValue('level') == Z_BEST_COMPRESSION ;
            $got->setValue('extraflags' => 4)
                if $got->getValue('level') == Z_BEST_SPEED ;
        }

        my $data = $got->getValue('extrafield') ;
        if (defined $data) {
            my $bad = IO::Compress::Zlib::Extra::parseExtraField($data, $strict, 1) ;
            return $self->saveErrorString(undef, "Error with ExtraField Parameter: $bad", Z_DATA_ERROR)
                if $bad ;

            $got->setValue('extrafield' => $data) ;
        }
    }

    return 1;
}

sub mkTrailer
{
    my $self = shift ;
    return pack("V V", *$self->{Compress}->crc32(),
                       *$self->{UnCompSize}->get32bit());
}

sub getInverseClass
{
    no warnings 'once';
    return ('IO::Uncompress::Gunzip',
                \$IO::Uncompress::Gunzip::GunzipError);
}

sub getFileInfo
{
    my $self = shift ;
    my $params = shift;
    my $filename = shift ;

    return if IO::Compress::Base::Common::isaScalar($filename);

    my $defaultTime = (stat($filename))[9] ;

    $params->setValue('name' => $filename)
        if ! $params->parsed('name') ;

    $params->setValue('time' => $defaultTime)
        if ! $params->parsed('time') ;
}


sub mkHeader
{
    my $self = shift ;
    my $param = shift ;

    # short-circuit if a minimal header is requested.
    return GZIP_MINIMUM_HEADER if $param->getValue('minimal') ;

    # METHOD
    my $method = $param->valueOrDefault('method', GZIP_CM_DEFLATED) ;

    # FLAGS
    my $flags       = GZIP_FLG_DEFAULT ;
    $flags |= GZIP_FLG_FTEXT    if $param->getValue('textflag') ;
    $flags |= GZIP_FLG_FHCRC    if $param->getValue('headercrc') ;
    $flags |= GZIP_FLG_FEXTRA   if $param->wantValue('extrafield') ;
    $flags |= GZIP_FLG_FNAME    if $param->wantValue('name') ;
    $flags |= GZIP_FLG_FCOMMENT if $param->wantValue('comment') ;

    # MTIME
    my $time = $param->valueOrDefault('time', GZIP_MTIME_DEFAULT) ;

    # EXTRA FLAGS
    my $extra_flags = $param->valueOrDefault('extraflags', GZIP_XFL_DEFAULT);

    # OS CODE
    my $os_code = $param->valueOrDefault('os_code', GZIP_OS_DEFAULT) ;


    my $out = pack("C4 V C C",
            GZIP_ID1,   # ID1
            GZIP_ID2,   # ID2
            $method,    # Compression Method
            $flags,     # Flags
            $time,      # Modification Time
            $extra_flags, # Extra Flags
            $os_code,   # Operating System Code
            ) ;

    # EXTRA
    if ($flags & GZIP_FLG_FEXTRA) {
        my $extra = $param->getValue('extrafield') ;
        $out .= pack("v", length $extra) . $extra ;
    }

    # NAME
    if ($flags & GZIP_FLG_FNAME) {
        my $name .= $param->getValue('name') ;
        $name =~ s/\x00.*$//;
        $out .= $name ;
        # Terminate the filename with NULL unless it already is
        $out .= GZIP_NULL_BYTE
            if !length $name or
               substr($name, 1, -1) ne GZIP_NULL_BYTE ;
    }

    # COMMENT
    if ($flags & GZIP_FLG_FCOMMENT) {
        my $comment .= $param->getValue('comment') ;
        $comment =~ s/\x00.*$//;
        $out .= $comment ;
        # Terminate the comment with NULL unless it already is
        $out .= GZIP_NULL_BYTE
            if ! length $comment or
               substr($comment, 1, -1) ne GZIP_NULL_BYTE;
    }

    # HEADER CRC
    $out .= pack("v", Compress::Raw::Zlib::crc32($out) & 0x00FF )
        if $param->getValue('headercrc') ;

    noUTF8($out);

    return $out ;
}

sub mkFinalTrailer
{
    return '';
}

1;

__END__

=head1 NAME

IO::Compress::Gzip - Write RFC 1952 files/buffers

=head1 SYNOPSIS

    use IO::Compress::Gzip qw(gzip $GzipError) ;

    my $status = gzip $input => $output [,OPTS]
        or die "gzip failed: $GzipError\n";

    my $z = IO::Compress::Gzip->new( $output [,OPTS] )
        or die "gzip failed: $GzipError\n";

    $z->print($string);
    $z->printf($format, $string);
    $z->write($string);
    $z->syswrite($string [, $length, $offset]);
    $z->flush();
    $z->tell();
    $z->eof();
    $z->seek($position, $whence);
    $z->binmode();
    $z->fileno();
    $z->opened();
    $z->autoflush();
    $z->input_line_number();
    $z->newStream( [OPTS] );

    $z->deflateParams();

    $z->close() ;

    $GzipError ;

    # IO::File mode

    print $z $string;
    printf $z $format, $string;
    tell $z
    eof $z
    seek $z, $position, $whence
    binmode $z
    fileno $z
    close $z ;

=head1 DESCRIPTION

This module provides a Perl interface that allows writing compressed
data to files or buffer as defined in RFC 1952.

All the gzip headers defined in RFC 1952 can be created using
this module.

For reading RFC 1952 files/buffers, see the companion module
L<IO::Uncompress::Gunzip|IO::Uncompress::Gunzip>.

=head1 Functional Interface

A top-level function, C<gzip>, is provided to carry out
"one-shot" compression between buffers and/or files. For finer
control over the compression process, see the L</"OO Interface">
section.

    use IO::Compress::Gzip qw(gzip $GzipError) ;

    gzip $input_filename_or_reference => $output_filename_or_reference [,OPTS]
        or die "gzip failed: $GzipError\n";

The functional interface needs Perl5.005 or better.

=head2 gzip $input_filename_or_reference => $output_filename_or_reference [, OPTS]

C<gzip> expects at least two parameters,
C<$input_filename_or_reference> and C<$output_filename_or_reference>
and zero or more optional parameters (see L</Optional Parameters>)

=head3 The C<$input_filename_or_reference> parameter

The parameter, C<$input_filename_or_reference>, is used to define the
source of the uncompressed data.

It can take one of the following forms:

=over 5

=item A filename

If the C<$input_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename. This file will be opened for reading and the
input data will be read from it.

=item A filehandle

If the C<$input_filename_or_reference> parameter is a filehandle, the input
data will be read from it.  The string '-' can be used as an alias for
standard input.

=item A scalar reference

If C<$input_filename_or_reference> is a scalar reference, the input data
will be read from C<$$input_filename_or_reference>.

=item An array reference

If C<$input_filename_or_reference> is an array reference, each element in
the array must be a filename.

The input data will be read from each file in turn.

The complete array will be walked to ensure that it only
contains valid filenames before any data is compressed.

=item An Input FileGlob string

If C<$input_filename_or_reference> is a string that is delimited by the
characters "<" and ">" C<gzip> will assume that it is an
I<input fileglob string>. The input is the list of files that match the
fileglob.

See L<File::GlobMapper|File::GlobMapper> for more details.

=back

If the C<$input_filename_or_reference> parameter is any other type,
C<undef> will be returned.

In addition, if C<$input_filename_or_reference> is a simple filename,
the default values for
the C<Name> and C<Time> options will be sourced from that file.

If you do not want to use these defaults they can be overridden by
explicitly setting the C<Name> and C<Time> options or by setting the
C<Minimal> parameter.

=head3 The C<$output_filename_or_reference> parameter

The parameter C<$output_filename_or_reference> is used to control the
destination of the compressed data. This parameter can take one of
these forms.

=over 5

=item A filename

If the C<$output_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename.  This file will be opened for writing and the
compressed data will be written to it.

=item A filehandle

If the C<$output_filename_or_reference> parameter is a filehandle, the
compressed data will be written to it.  The string '-' can be used as
an alias for standard output.

=item A scalar reference

If C<$output_filename_or_reference> is a scalar reference, the
compressed data will be stored in C<$$output_filename_or_reference>.

=item An Array Reference

If C<$output_filename_or_reference> is an array reference,
the compressed data will be pushed onto the array.

=item An Output FileGlob

If C<$output_filename_or_reference> is a string that is delimited by the
characters "<" and ">" C<gzip> will assume that it is an
I<output fileglob string>. The output is the list of files that match the
fileglob.

When C<$output_filename_or_reference> is an fileglob string,
C<$input_filename_or_reference> must also be a fileglob string. Anything
else is an error.

See L<File::GlobMapper|File::GlobMapper> for more details.

=back

If the C<$output_filename_or_reference> parameter is any other type,
C<undef> will be returned.

=head2 Notes

When C<$input_filename_or_reference> maps to multiple files/buffers and
C<$output_filename_or_reference> is a single
file/buffer the input files/buffers will be stored
in C<$output_filename_or_reference> as a concatenated series of compressed data streams.

=head2 Optional Parameters

The optional parameters for the one-shot function C<gzip>
are (for the most part) identical to those used with the OO interface defined in the
L</"Constructor Options"> section. The exceptions are listed below

=over 5

=item C<< AutoClose => 0|1 >>

This option applies to any input or output data streams to
C<gzip> that are filehandles.

If C<AutoClose> is specified, and the value is true, it will result in all
input and/or output filehandles being closed once C<gzip> has
completed.

This parameter defaults to 0.

=item C<< BinModeIn => 0|1 >>

This option is now a no-op. All files will be read in binmode.

=item C<< Append => 0|1 >>

The behaviour of this option is dependent on the type of output data
stream.

=over 5

=item * A Buffer

If C<Append> is enabled, all compressed data will be append to the end of
the output buffer. Otherwise the output buffer will be cleared before any
compressed data is written to it.

=item * A Filename

If C<Append> is enabled, the file will be opened in append mode. Otherwise
the contents of the file, if any, will be truncated before any compressed
data is written to it.

=item * A Filehandle

If C<Append> is enabled, the filehandle will be positioned to the end of
the file via a call to C<seek> before any compressed data is
written to it.  Otherwise the file pointer will not be moved.

=back

When C<Append> is specified, and set to true, it will I<append> all compressed
data to the output data stream.

So when the output is a filehandle it will carry out a seek to the eof
before writing any compressed data. If the output is a filename, it will be opened for
appending. If the output is a buffer, all compressed data will be
appended to the existing buffer.

Conversely when C<Append> is not specified, or it is present and is set to
false, it will operate as follows.

When the output is a filename, it will truncate the contents of the file
before writing any compressed data. If the output is a filehandle
its position will not be changed. If the output is a buffer, it will be
wiped before any compressed data is output.

Defaults to 0.

=back

=head2 Examples

Here are a few example that show the capabilities of the module.

=head3 Streaming

This very simple command line example demonstrates the streaming capabilities of the module.
The code reads data from STDIN, compresses it, and writes the compressed data to STDOUT.

    $ echo hello world | perl -MIO::Compress::Gzip=gzip -e 'gzip \*STDIN => \*STDOUT' >output.gz

The special filename "-" can be used as a standin for both C<\*STDIN> and C<\*STDOUT>,
so the above can be rewritten as

    $ echo hello world | perl -MIO::Compress::Gzip=gzip -e 'gzip "-" => "-"' >output.gz

=head3 Compressing a file from the filesystem

To read the contents of the file C<file1.txt> and write the compressed
data to the file C<file1.txt.gz>.

    use strict ;
    use warnings ;
    use IO::Compress::Gzip qw(gzip $GzipError) ;

    my $input = "file1.txt";
    gzip $input => "$input.gz"
        or die "gzip failed: $GzipError\n";

=head3 Reading from a Filehandle and writing to an in-memory buffer

To read from an existing Perl filehandle, C<$input>, and write the
compressed data to a buffer, C<$buffer>.

    use strict ;
    use warnings ;
    use IO::Compress::Gzip qw(gzip $GzipError) ;
    use IO::File ;

    my $input = IO::File->new( "<file1.txt" )
        or die "Cannot open 'file1.txt': $!\n" ;
    my $buffer ;
    gzip $input => \$buffer
        or die "gzip failed: $GzipError\n";

=head3 Compressing multiple files

To compress all files in the directory "/my/home" that match "*.txt"
and store the compressed data in the same directory

    use strict ;
    use warnings ;
    use IO::Compress::Gzip qw(gzip $GzipError) ;

    gzip '</my/home/*.txt>' => '<*.gz>'
        or die "gzip failed: $GzipError\n";

and if you want to compress each file one at a time, this will do the trick

    use strict ;
    use warnings ;
    use IO::Compress::Gzip qw(gzip $GzipError) ;

    for my $input ( glob "/my/home/*.txt" )
    {
        my $output = "$input.gz" ;
        gzip $input => $output
            or die "Error compressing '$input': $GzipError\n";
    }

=head1 OO Interface

=head2 Constructor

The format of the constructor for C<IO::Compress::Gzip> is shown below

    my $z = IO::Compress::Gzip->new( $output [,OPTS] )
        or die "IO::Compress::Gzip failed: $GzipError\n";

It returns an C<IO::Compress::Gzip> object on success and undef on failure.
The variable C<$GzipError> will contain an error message on failure.

If you are running Perl 5.005 or better the object, C<$z>, returned from
IO::Compress::Gzip can be used exactly like an L<IO::File|IO::File> filehandle.
This means that all normal output file operations can be carried out
with C<$z>.
For example, to write to a compressed file/buffer you can use either of
these forms

    $z->print("hello world\n");
    print $z "hello world\n";

The mandatory parameter C<$output> is used to control the destination
of the compressed data. This parameter can take one of these forms.

=over 5

=item A filename

If the C<$output> parameter is a simple scalar, it is assumed to be a
filename. This file will be opened for writing and the compressed data
will be written to it.

=item A filehandle

If the C<$output> parameter is a filehandle, the compressed data will be
written to it.
The string '-' can be used as an alias for standard output.

=item A scalar reference

If C<$output> is a scalar reference, the compressed data will be stored
in C<$$output>.

=back

If the C<$output> parameter is any other type, C<IO::Compress::Gzip>::new will
return undef.

=head2 Constructor Options

C<OPTS> is any combination of zero or more the following options:

=over 5

=item C<< AutoClose => 0|1 >>

This option is only valid when the C<$output> parameter is a filehandle. If
specified, and the value is true, it will result in the C<$output> being
closed once either the C<close> method is called or the C<IO::Compress::Gzip>
object is destroyed.

This parameter defaults to 0.

=item C<< Append => 0|1 >>

Opens C<$output> in append mode.

The behaviour of this option is dependent on the type of C<$output>.

=over 5

=item * A Buffer

If C<$output> is a buffer and C<Append> is enabled, all compressed data
will be append to the end of C<$output>. Otherwise C<$output> will be
cleared before any data is written to it.

=item * A Filename

If C<$output> is a filename and C<Append> is enabled, the file will be
opened in append mode. Otherwise the contents of the file, if any, will be
truncated before any compressed data is written to it.

=item * A Filehandle

If C<$output> is a filehandle, the file pointer will be positioned to the
end of the file via a call to C<seek> before any compressed data is written
to it.  Otherwise the file pointer will not be moved.

=back

This parameter defaults to 0.

=item C<< Merge => 0|1 >>

This option is used to compress input data and append it to an existing
compressed data stream in C<$output>. The end result is a single compressed
data stream stored in C<$output>.

It is a fatal error to attempt to use this option when C<$output> is not an
RFC 1952 data stream.

There are a number of other limitations with the C<Merge> option:

=over 5

=item 1

This module needs to have been built with zlib 1.2.1 or better to work. A
fatal error will be thrown if C<Merge> is used with an older version of
zlib.

=item 2

If C<$output> is a file or a filehandle, it must be seekable.

=back

This parameter defaults to 0.

=item -Level

Defines the compression level used by zlib. The value should either be
a number between 0 and 9 (0 means no compression and 9 is maximum
compression), or one of the symbolic constants defined below.

   Z_NO_COMPRESSION
   Z_BEST_SPEED
   Z_BEST_COMPRESSION
   Z_DEFAULT_COMPRESSION

The default is Z_DEFAULT_COMPRESSION.

Note, these constants are not imported by C<IO::Compress::Gzip> by default.

    use IO::Compress::Gzip qw(:strategy);
    use IO::Compress::Gzip qw(:constants);
    use IO::Compress::Gzip qw(:all);

=item -Strategy

Defines the strategy used to tune the compression. Use one of the symbolic
constants defined below.

   Z_FILTERED
   Z_HUFFMAN_ONLY
   Z_RLE
   Z_FIXED
   Z_DEFAULT_STRATEGY

The default is Z_DEFAULT_STRATEGY.

=item C<< Minimal => 0|1 >>

If specified, this option will force the creation of the smallest possible
compliant gzip header (which is exactly 10 bytes long) as defined in
RFC 1952.

See the section titled "Compliance" in RFC 1952 for a definition
of the values used for the fields in the gzip header.

All other parameters that control the content of the gzip header will
be ignored if this parameter is set to 1.

This parameter defaults to 0.

=item C<< Comment => $comment >>

Stores the contents of C<$comment> in the COMMENT field in
the gzip header.
By default, no comment field is written to the gzip file.

If the C<-Strict> option is enabled, the comment can only consist of ISO
8859-1 characters plus line feed.

If the C<-Strict> option is disabled, the comment field can contain any
character except NULL. If any null characters are present, the field
will be truncated at the first NULL.

=item C<< Name => $string >>

Stores the contents of C<$string> in the gzip NAME header field. If
C<Name> is not specified, no gzip NAME field will be created.

If the C<-Strict> option is enabled, C<$string> can only consist of ISO
8859-1 characters.

If C<-Strict> is disabled, then C<$string> can contain any character
except NULL. If any null characters are present, the field will be
truncated at the first NULL.

=item C<< Time => $number >>

Sets the MTIME field in the gzip header to $number.

This field defaults to the time the C<IO::Compress::Gzip> object was created
if this option is not specified.

=item C<< TextFlag => 0|1 >>

This parameter controls the setting of the FLG.FTEXT bit in the gzip
header. It is used to signal that the data stored in the gzip file/buffer
is probably text.

The default is 0.

=item C<< HeaderCRC => 0|1 >>

When true this parameter will set the FLG.FHCRC bit to 1 in the gzip header
and set the CRC16 header field to the CRC of the complete gzip header
except the CRC16 field itself.

B<Note> that gzip files created with the C<HeaderCRC> flag set to 1 cannot
be read by most, if not all, of the standard gunzip utilities, most
notably gzip version 1.2.4. You should therefore avoid using this option if
you want to maximize the portability of your gzip files.

This parameter defaults to 0.

=item C<< OS_Code => $value >>

Stores C<$value> in the gzip OS header field. A number between 0 and 255 is
valid.

If not specified, this parameter defaults to the OS code of the Operating
System this module was built on. The value 3 is used as a catch-all for all
Unix variants and unknown Operating Systems.

=item C<< ExtraField => $data >>

This parameter allows additional metadata to be stored in the ExtraField in
the gzip header. An RFC 1952 compliant ExtraField consists of zero or more
subfields. Each subfield consists of a two byte header followed by the
subfield data.

The list of subfields can be supplied in any of the following formats

    -ExtraField => [$id1, $data1,
                    $id2, $data2,
                     ...
                   ]
    -ExtraField => [ [$id1 => $data1],
                     [$id2 => $data2],
                     ...
                   ]
    -ExtraField => { $id1 => $data1,
                     $id2 => $data2,
                     ...
                   }

Where C<$id1>, C<$id2> are two byte subfield ID's. The second byte of
the ID cannot be 0, unless the C<Strict> option has been disabled.

If you use the hash syntax, you have no control over the order in which
the ExtraSubFields are stored, plus you cannot have SubFields with
duplicate ID.

Alternatively the list of subfields can by supplied as a scalar, thus

    -ExtraField => $rawdata

If you use the raw format, and the C<Strict> option is enabled,
C<IO::Compress::Gzip> will check that C<$rawdata> consists of zero or more
conformant sub-fields. When C<Strict> is disabled, C<$rawdata> can
consist of any arbitrary byte stream.

The maximum size of the Extra Field 65535 bytes.

=item C<< ExtraFlags => $value >>

Sets the XFL byte in the gzip header to C<$value>.

If this option is not present, the value stored in XFL field will be
determined by the setting of the C<Level> option.

If C<< Level => Z_BEST_SPEED >> has been specified then XFL is set to 2.
If C<< Level => Z_BEST_COMPRESSION >> has been specified then XFL is set to 4.
Otherwise XFL is set to 0.

=item C<< Strict => 0|1 >>

C<Strict> will optionally police the values supplied with other options
to ensure they are compliant with RFC1952.

This option is enabled by default.

If C<Strict> is enabled the following behaviour will be policed:

=over 5

=item *

The value supplied with the C<Name> option can only contain ISO 8859-1
characters.

=item *

The value supplied with the C<Comment> option can only contain ISO 8859-1
characters plus line-feed.

=item *

The values supplied with the C<-Name> and C<-Comment> options cannot
contain multiple embedded nulls.

=item *

If an C<ExtraField> option is specified and it is a simple scalar,
it must conform to the sub-field structure as defined in RFC 1952.

=item *

If an C<ExtraField> option is specified the second byte of the ID will be
checked in each subfield to ensure that it does not contain the reserved
value 0x00.

=back

When C<Strict> is disabled the following behaviour will be policed:

=over 5

=item *

The value supplied with C<-Name> option can contain
any character except NULL.

=item *

The value supplied with C<-Comment> option can contain any character
except NULL.

=item *

The values supplied with the C<-Name> and C<-Comment> options can contain
multiple embedded nulls. The string written to the gzip header will
consist of the characters up to, but not including, the first embedded
NULL.

=item *

If an C<ExtraField> option is specified and it is a simple scalar, the
structure will not be checked. The only error is if the length is too big.

=item *

The ID header in an C<ExtraField> sub-field can consist of any two bytes.

=back

=back

=head2 Examples

TODO

=head1 Methods

=head2 print

Usage is

    $z->print($data)
    print $z $data

Compresses and outputs the contents of the C<$data> parameter. This
has the same behaviour as the C<print> built-in.

Returns true if successful.

=head2 printf

Usage is

    $z->printf($format, $data)
    printf $z $format, $data

Compresses and outputs the contents of the C<$data> parameter.

Returns true if successful.

=head2 syswrite

Usage is

    $z->syswrite $data
    $z->syswrite $data, $length
    $z->syswrite $data, $length, $offset

Compresses and outputs the contents of the C<$data> parameter.

Returns the number of uncompressed bytes written, or C<undef> if
unsuccessful.

=head2 write

Usage is

    $z->write $data
    $z->write $data, $length
    $z->write $data, $length, $offset

Compresses and outputs the contents of the C<$data> parameter.

Returns the number of uncompressed bytes written, or C<undef> if
unsuccessful.

=head2 flush

Usage is

    $z->flush;
    $z->flush($flush_type);

Flushes any pending compressed data to the output file/buffer.

This method takes an optional parameter, C<$flush_type>, that controls
how the flushing will be carried out. By default the C<$flush_type>
used is C<Z_FINISH>. Other valid values for C<$flush_type> are
C<Z_NO_FLUSH>, C<Z_SYNC_FLUSH>, C<Z_FULL_FLUSH> and C<Z_BLOCK>. It is
strongly recommended that you only set the C<flush_type> parameter if
you fully understand the implications of what it does - overuse of C<flush>
can seriously degrade the level of compression achieved. See the C<zlib>
documentation for details.

Returns true on success.

=head2 tell

Usage is

    $z->tell()
    tell $z

Returns the uncompressed file offset.

=head2 eof

Usage is

    $z->eof();
    eof($z);

Returns true if the C<close> method has been called.

=head2 seek

    $z->seek($position, $whence);
    seek($z, $position, $whence);

Provides a sub-set of the C<seek> functionality, with the restriction
that it is only legal to seek forward in the output file/buffer.
It is a fatal error to attempt to seek backward.

Empty parts of the file/buffer will have NULL (0x00) bytes written to them.

The C<$whence> parameter takes one the usual values, namely SEEK_SET,
SEEK_CUR or SEEK_END.

Returns 1 on success, 0 on failure.

=head2 binmode

Usage is

    $z->binmode
    binmode $z ;

This is a noop provided for completeness.

=head2 opened

    $z->opened()

Returns true if the object currently refers to a opened file/buffer.

=head2 autoflush

    my $prev = $z->autoflush()
    my $prev = $z->autoflush(EXPR)

If the C<$z> object is associated with a file or a filehandle, this method
returns the current autoflush setting for the underlying filehandle. If
C<EXPR> is present, and is non-zero, it will enable flushing after every
write/print operation.

If C<$z> is associated with a buffer, this method has no effect and always
returns C<undef>.

B<Note> that the special variable C<$|> B<cannot> be used to set or
retrieve the autoflush setting.

=head2 input_line_number

    $z->input_line_number()
    $z->input_line_number(EXPR)

This method always returns C<undef> when compressing.

=head2 fileno

    $z->fileno()
    fileno($z)

If the C<$z> object is associated with a file or a filehandle, C<fileno>
will return the underlying file descriptor. Once the C<close> method is
called C<fileno> will return C<undef>.

If the C<$z> object is associated with a buffer, this method will return
C<undef>.

=head2 close

    $z->close() ;
    close $z ;

Flushes any pending compressed data and then closes the output file/buffer.

For most versions of Perl this method will be automatically invoked if
the IO::Compress::Gzip object is destroyed (either explicitly or by the
variable with the reference to the object going out of scope). The
exceptions are Perl versions 5.005 through 5.00504 and 5.8.0. In
these cases, the C<close> method will be called automatically, but
not until global destruction of all live objects when the program is
terminating.

Therefore, if you want your scripts to be able to run on all versions
of Perl, you should call C<close> explicitly and not rely on automatic
closing.

Returns true on success, otherwise 0.

If the C<AutoClose> option has been enabled when the IO::Compress::Gzip
object was created, and the object is associated with a file, the
underlying file will also be closed.

=head2 newStream([OPTS])

Usage is

    $z->newStream( [OPTS] )

Closes the current compressed data stream and starts a new one.

OPTS consists of any of the options that are available when creating
the C<$z> object.

See the L</"Constructor Options"> section for more details.

=head2 deflateParams

Usage is

    $z->deflateParams

TODO

=head1 Importing

A number of symbolic constants are required by some methods in
C<IO::Compress::Gzip>. None are imported by default.

=over 5

=item :all

Imports C<gzip>, C<$GzipError> and all symbolic
constants that can be used by C<IO::Compress::Gzip>. Same as doing this

    use IO::Compress::Gzip qw(gzip $GzipError :constants) ;

=item :constants

Import all symbolic constants. Same as doing this

    use IO::Compress::Gzip qw(:flush :level :strategy) ;

=item :flush

These symbolic constants are used by the C<flush> method.

    Z_NO_FLUSH
    Z_PARTIAL_FLUSH
    Z_SYNC_FLUSH
    Z_FULL_FLUSH
    Z_FINISH
    Z_BLOCK

=item :level

These symbolic constants are used by the C<Level> option in the constructor.

    Z_NO_COMPRESSION
    Z_BEST_SPEED
    Z_BEST_COMPRESSION
    Z_DEFAULT_COMPRESSION

=item :strategy

These symbolic constants are used by the C<Strategy> option in the constructor.

    Z_FILTERED
    Z_HUFFMAN_ONLY
    Z_RLE
    Z_FIXED
    Z_DEFAULT_STRATEGY

=back

=head1 EXAMPLES

=head2 Apache::GZip Revisited

See L<IO::Compress::FAQ|IO::Compress::FAQ/"Apache::GZip Revisited">

=head2 Working with Net::FTP

See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP">

=head1 SUPPORT

General feedback/questions/bug reports should be sent to
L<https://github.com/pmqs/IO-Copress/issues> (preferred) or
L<https://rt.cpan.org/Public/Dist/Display.html?Name=IO-Copress>.

=head1 SEE ALSO

L<Compress::Zlib>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzip>, L<IO::Uncompress::UnLzip>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Compress::Zstd>, L<IO::Uncompress::UnZstd>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>

L<IO::Compress::FAQ|IO::Compress::FAQ>

L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>,
L<Archive::Tar|Archive::Tar>,
L<IO::Zlib|IO::Zlib>

For RFC 1950, 1951 and 1952 see
L<http://www.faqs.org/rfcs/rfc1950.html>,
L<http://www.faqs.org/rfcs/rfc1951.html> and
L<http://www.faqs.org/rfcs/rfc1952.html>

The I<zlib> compression library was written by Jean-loup Gailly
C<gzip@prep.ai.mit.edu> and Mark Adler C<madler@alumni.caltech.edu>.

The primary site for the I<zlib> compression library is
L<http://www.zlib.org>.

The primary site for gzip is L<http://www.gzip.org>.

=head1 AUTHOR

This module was written by Paul Marquess, C<pmqs@cpan.org>.

=head1 MODIFICATION HISTORY

See the Changes file.

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2005-2021 Paul Marquess. All rights reserved.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
                                                                                                                                                                    Compress/RawDeflate.pm                                                                              0000644                 00000064425 00000000000 0010667 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       package IO::Compress::RawDeflate ;

# create RFC1951
#
use strict ;
use warnings;
use bytes;

use IO::Compress::Base 2.101 ;
use IO::Compress::Base::Common  2.101 qw(:Status :Parse);
use IO::Compress::Adapter::Deflate 2.101 ;
use Compress::Raw::Zlib  2.101 qw(Z_DEFLATED Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY);

require Exporter ;

our ($VERSION, @ISA, @EXPORT_OK, %DEFLATE_CONSTANTS, %EXPORT_TAGS, $RawDeflateError);

$VERSION = '2.102';
$RawDeflateError = '';

@ISA = qw(IO::Compress::Base Exporter);
@EXPORT_OK = qw( $RawDeflateError rawdeflate ) ;
push @EXPORT_OK, @IO::Compress::Adapter::Deflate::EXPORT_OK ;

%EXPORT_TAGS = %IO::Compress::Adapter::Deflate::DEFLATE_CONSTANTS;


{
    my %seen;
    foreach (keys %EXPORT_TAGS )
    {
        push @{$EXPORT_TAGS{constants}},
                 grep { !$seen{$_}++ }
                 @{ $EXPORT_TAGS{$_} }
    }
    $EXPORT_TAGS{all} = $EXPORT_TAGS{constants} ;
}


%DEFLATE_CONSTANTS = %EXPORT_TAGS;

#push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;

Exporter::export_ok_tags('all');



sub new
{
    my $class = shift ;

    my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$RawDeflateError);

    return $obj->_create(undef, @_);
}

sub rawdeflate
{
    my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$RawDeflateError);
    return $obj->_def(@_);
}

sub ckParams
{
    my $self = shift ;
    my $got = shift;

    return 1 ;
}

sub mkComp
{
    my $self = shift ;
    my $got = shift ;

    my ($obj, $errstr, $errno) = IO::Compress::Adapter::Deflate::mkCompObject(
                                                 $got->getValue('crc32'),
                                                 $got->getValue('adler32'),
                                                 $got->getValue('level'),
                                                 $got->getValue('strategy')
                                                 );

   return $self->saveErrorString(undef, $errstr, $errno)
       if ! defined $obj;

   return $obj;
}


sub mkHeader
{
    my $self = shift ;
    return '';
}

sub mkTrailer
{
    my $self = shift ;
    return '';
}

sub mkFinalTrailer
{
    return '';
}


#sub newHeader
#{
#    my $self = shift ;
#    return '';
#}

sub getExtraParams
{
    my $self = shift ;
    return getZlibParams();
}

our %PARAMS = (
            #'method'   => [IO::Compress::Base::Common::Parse_unsigned,  Z_DEFLATED],
            'level'     => [IO::Compress::Base::Common::Parse_signed,    Z_DEFAULT_COMPRESSION],
            'strategy'  => [IO::Compress::Base::Common::Parse_signed,    Z_DEFAULT_STRATEGY],

            'crc32'     => [IO::Compress::Base::Common::Parse_boolean,   0],
            'adler32'   => [IO::Compress::Base::Common::Parse_boolean,   0],
            'merge'     => [IO::Compress::Base::Common::Parse_boolean,   0],
        );

sub getZlibParams
{
    return %PARAMS;
}

sub getInverseClass
{
    no warnings 'once';
    return ('IO::Uncompress::RawInflate',
                \$IO::Uncompress::RawInflate::RawInflateError);
}

sub getFileInfo
{
    my $self = shift ;
    my $params = shift;
    my $file = shift ;

}

use Fcntl qw(SEEK_SET);

sub createMerge
{
    my $self = shift ;
    my $outValue = shift ;
    my $outType = shift ;

    my ($invClass, $error_ref) = $self->getInverseClass();
    eval "require $invClass"
        or die "aaaahhhh" ;

    my $inf = $invClass->new( $outValue,
                             Transparent => 0,
                             #Strict     => 1,
                             AutoClose   => 0,
                             Scan        => 1)
       or return $self->saveErrorString(undef, "Cannot create InflateScan object: $$error_ref" ) ;

    my $end_offset = 0;
    $inf->scan()
        or return $self->saveErrorString(undef, "Error Scanning: $$error_ref", $inf->errorNo) ;
    $inf->zap($end_offset)
        or return $self->saveErrorString(undef, "Error Zapping: $$error_ref", $inf->errorNo) ;

    my $def = *$self->{Compress} = $inf->createDeflate();

    *$self->{Header} = *$inf->{Info}{Header};
    *$self->{UnCompSize} = *$inf->{UnCompSize}->clone();
    *$self->{CompSize} = *$inf->{CompSize}->clone();
    # TODO -- fix this
    #*$self->{CompSize} = U64->new(0, *$self->{UnCompSize_32bit});


    if ( $outType eq 'buffer')
      { substr( ${ *$self->{Buffer} }, $end_offset) = '' }
    elsif ($outType eq 'handle' || $outType eq 'filename') {
        *$self->{FH} = *$inf->{FH} ;
        delete *$inf->{FH};
        *$self->{FH}->flush() ;
        *$self->{Handle} = 1 if $outType eq 'handle';

        #seek(*$self->{FH}, $end_offset, SEEK_SET)
        *$self->{FH}->seek($end_offset, SEEK_SET)
            or return $self->saveErrorString(undef, $!, $!) ;
    }

    return $def ;
}

#### zlib specific methods

sub deflateParams
{
    my $self = shift ;

    my $level = shift ;
    my $strategy = shift ;

    my $status = *$self->{Compress}->deflateParams(Level => $level, Strategy => $strategy) ;
    return $self->saveErrorString(0, *$self->{Compress}{Error}, *$self->{Compress}{ErrorNo})
        if $status == STATUS_ERROR;

    return 1;
}




1;

__END__

=head1 NAME

IO::Compress::RawDeflate - Write RFC 1951 files/buffers

=head1 SYNOPSIS

    use IO::Compress::RawDeflate qw(rawdeflate $RawDeflateError) ;

    my $status = rawdeflate $input => $output [,OPTS]
        or die "rawdeflate failed: $RawDeflateError\n";

    my $z = IO::Compress::RawDeflate->new( $output [,OPTS] )
        or die "rawdeflate failed: $RawDeflateError\n";

    $z->print($string);
    $z->printf($format, $string);
    $z->write($string);
    $z->syswrite($string [, $length, $offset]);
    $z->flush();
    $z->tell();
    $z->eof();
    $z->seek($position, $whence);
    $z->binmode();
    $z->fileno();
    $z->opened();
    $z->autoflush();
    $z->input_line_number();
    $z->newStream( [OPTS] );

    $z->deflateParams();

    $z->close() ;

    $RawDeflateError ;

    # IO::File mode

    print $z $string;
    printf $z $format, $string;
    tell $z
    eof $z
    seek $z, $position, $whence
    binmode $z
    fileno $z
    close $z ;

=head1 DESCRIPTION

This module provides a Perl interface that allows writing compressed
data to files or buffer as defined in RFC 1951.

Note that RFC 1951 data is not a good choice of compression format
to use in isolation, especially if you want to auto-detect it.

For reading RFC 1951 files/buffers, see the companion module
L<IO::Uncompress::RawInflate|IO::Uncompress::RawInflate>.

=head1 Functional Interface

A top-level function, C<rawdeflate>, is provided to carry out
"one-shot" compression between buffers and/or files. For finer
control over the compression process, see the L</"OO Interface">
section.

    use IO::Compress::RawDeflate qw(rawdeflate $RawDeflateError) ;

    rawdeflate $input_filename_or_reference => $output_filename_or_reference [,OPTS]
        or die "rawdeflate failed: $RawDeflateError\n";

The functional interface needs Perl5.005 or better.

=head2 rawdeflate $input_filename_or_reference => $output_filename_or_reference [, OPTS]

C<rawdeflate> expects at least two parameters,
C<$input_filename_or_reference> and C<$output_filename_or_reference>
and zero or more optional parameters (see L</Optional Parameters>)

=head3 The C<$input_filename_or_reference> parameter

The parameter, C<$input_filename_or_reference>, is used to define the
source of the uncompressed data.

It can take one of the following forms:

=over 5

=item A filename

If the C<$input_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename. This file will be opened for reading and the
input data will be read from it.

=item A filehandle

If the C<$input_filename_or_reference> parameter is a filehandle, the input
data will be read from it.  The string '-' can be used as an alias for
standard input.

=item A scalar reference

If C<$input_filename_or_reference> is a scalar reference, the input data
will be read from C<$$input_filename_or_reference>.

=item An array reference

If C<$input_filename_or_reference> is an array reference, each element in
the array must be a filename.

The input data will be read from each file in turn.

The complete array will be walked to ensure that it only
contains valid filenames before any data is compressed.

=item An Input FileGlob string

If C<$input_filename_or_reference> is a string that is delimited by the
characters "<" and ">" C<rawdeflate> will assume that it is an
I<input fileglob string>. The input is the list of files that match the
fileglob.

See L<File::GlobMapper|File::GlobMapper> for more details.

=back

If the C<$input_filename_or_reference> parameter is any other type,
C<undef> will be returned.

=head3 The C<$output_filename_or_reference> parameter

The parameter C<$output_filename_or_reference> is used to control the
destination of the compressed data. This parameter can take one of
these forms.

=over 5

=item A filename

If the C<$output_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename.  This file will be opened for writing and the
compressed data will be written to it.

=item A filehandle

If the C<$output_filename_or_reference> parameter is a filehandle, the
compressed data will be written to it.  The string '-' can be used as
an alias for standard output.

=item A scalar reference

If C<$output_filename_or_reference> is a scalar reference, the
compressed data will be stored in C<$$output_filename_or_reference>.

=item An Array Reference

If C<$output_filename_or_reference> is an array reference,
the compressed data will be pushed onto the array.

=item An Output FileGlob

If C<$output_filename_or_reference> is a string that is delimited by the
characters "<" and ">" C<rawdeflate> will assume that it is an
I<output fileglob string>. The output is the list of files that match the
fileglob.

When C<$output_filename_or_reference> is an fileglob string,
C<$input_filename_or_reference> must also be a fileglob string. Anything
else is an error.

See L<File::GlobMapper|File::GlobMapper> for more details.

=back

If the C<$output_filename_or_reference> parameter is any other type,
C<undef> will be returned.

=head2 Notes

When C<$input_filename_or_reference> maps to multiple files/buffers and
C<$output_filename_or_reference> is a single
file/buffer the input files/buffers will be stored
in C<$output_filename_or_reference> as a concatenated series of compressed data streams.

=head2 Optional Parameters

The optional parameters for the one-shot function C<rawdeflate>
are (for the most part) identical to those used with the OO interface defined in the
L</"Constructor Options"> section. The exceptions are listed below

=over 5

=item C<< AutoClose => 0|1 >>

This option applies to any input or output data streams to
C<rawdeflate> that are filehandles.

If C<AutoClose> is specified, and the value is true, it will result in all
input and/or output filehandles being closed once C<rawdeflate> has
completed.

This parameter defaults to 0.

=item C<< BinModeIn => 0|1 >>

This option is now a no-op. All files will be read in binmode.

=item C<< Append => 0|1 >>

The behaviour of this option is dependent on the type of output data
stream.

=over 5

=item * A Buffer

If C<Append> is enabled, all compressed data will be append to the end of
the output buffer. Otherwise the output buffer will be cleared before any
compressed data is written to it.

=item * A Filename

If C<Append> is enabled, the file will be opened in append mode. Otherwise
the contents of the file, if any, will be truncated before any compressed
data is written to it.

=item * A Filehandle

If C<Append> is enabled, the filehandle will be positioned to the end of
the file via a call to C<seek> before any compressed data is
written to it.  Otherwise the file pointer will not be moved.

=back

When C<Append> is specified, and set to true, it will I<append> all compressed
data to the output data stream.

So when the output is a filehandle it will carry out a seek to the eof
before writing any compressed data. If the output is a filename, it will be opened for
appending. If the output is a buffer, all compressed data will be
appended to the existing buffer.

Conversely when C<Append> is not specified, or it is present and is set to
false, it will operate as follows.

When the output is a filename, it will truncate the contents of the file
before writing any compressed data. If the output is a filehandle
its position will not be changed. If the output is a buffer, it will be
wiped before any compressed data is output.

Defaults to 0.

=back

=head2 Examples

Here are a few example that show the capabilities of the module.

=head3 Streaming

This very simple command line example demonstrates the streaming capabilities of the module.
The code reads data from STDIN, compresses it, and writes the compressed data to STDOUT.

    $ echo hello world | perl -MIO::Compress::RawDeflate=rawdeflate -e 'rawdeflate \*STDIN => \*STDOUT' >output.1951

The special filename "-" can be used as a standin for both C<\*STDIN> and C<\*STDOUT>,
so the above can be rewritten as

    $ echo hello world | perl -MIO::Compress::RawDeflate=rawdeflate -e 'rawdeflate "-" => "-"' >output.1951

=head3 Compressing a file from the filesystem

To read the contents of the file C<file1.txt> and write the compressed
data to the file C<file1.txt.1951>.

    use strict ;
    use warnings ;
    use IO::Compress::RawDeflate qw(rawdeflate $RawDeflateError) ;

    my $input = "file1.txt";
    rawdeflate $input => "$input.1951"
        or die "rawdeflate failed: $RawDeflateError\n";

=head3 Reading from a Filehandle and writing to an in-memory buffer

To read from an existing Perl filehandle, C<$input>, and write the
compressed data to a buffer, C<$buffer>.

    use strict ;
    use warnings ;
    use IO::Compress::RawDeflate qw(rawdeflate $RawDeflateError) ;
    use IO::File ;

    my $input = IO::File->new( "<file1.txt" )
        or die "Cannot open 'file1.txt': $!\n" ;
    my $buffer ;
    rawdeflate $input => \$buffer
        or die "rawdeflate failed: $RawDeflateError\n";

=head3 Compressing multiple files

To compress all files in the directory "/my/home" that match "*.txt"
and store the compressed data in the same directory

    use strict ;
    use warnings ;
    use IO::Compress::RawDeflate qw(rawdeflate $RawDeflateError) ;

    rawdeflate '</my/home/*.txt>' => '<*.1951>'
        or die "rawdeflate failed: $RawDeflateError\n";

and if you want to compress each file one at a time, this will do the trick

    use strict ;
    use warnings ;
    use IO::Compress::RawDeflate qw(rawdeflate $RawDeflateError) ;

    for my $input ( glob "/my/home/*.txt" )
    {
        my $output = "$input.1951" ;
        rawdeflate $input => $output
            or die "Error compressing '$input': $RawDeflateError\n";
    }

=head1 OO Interface

=head2 Constructor

The format of the constructor for C<IO::Compress::RawDeflate> is shown below

    my $z = IO::Compress::RawDeflate->new( $output [,OPTS] )
        or die "IO::Compress::RawDeflate failed: $RawDeflateError\n";

It returns an C<IO::Compress::RawDeflate> object on success and undef on failure.
The variable C<$RawDeflateError> will contain an error message on failure.

If you are running Perl 5.005 or better the object, C<$z>, returned from
IO::Compress::RawDeflate can be used exactly like an L<IO::File|IO::File> filehandle.
This means that all normal output file operations can be carried out
with C<$z>.
For example, to write to a compressed file/buffer you can use either of
these forms

    $z->print("hello world\n");
    print $z "hello world\n";

The mandatory parameter C<$output> is used to control the destination
of the compressed data. This parameter can take one of these forms.

=over 5

=item A filename

If the C<$output> parameter is a simple scalar, it is assumed to be a
filename. This file will be opened for writing and the compressed data
will be written to it.

=item A filehandle

If the C<$output> parameter is a filehandle, the compressed data will be
written to it.
The string '-' can be used as an alias for standard output.

=item A scalar reference

If C<$output> is a scalar reference, the compressed data will be stored
in C<$$output>.

=back

If the C<$output> parameter is any other type, C<IO::Compress::RawDeflate>::new will
return undef.

=head2 Constructor Options

C<OPTS> is any combination of zero or more the following options:

=over 5

=item C<< AutoClose => 0|1 >>

This option is only valid when the C<$output> parameter is a filehandle. If
specified, and the value is true, it will result in the C<$output> being
closed once either the C<close> method is called or the C<IO::Compress::RawDeflate>
object is destroyed.

This parameter defaults to 0.

=item C<< Append => 0|1 >>

Opens C<$output> in append mode.

The behaviour of this option is dependent on the type of C<$output>.

=over 5

=item * A Buffer

If C<$output> is a buffer and C<Append> is enabled, all compressed data
will be append to the end of C<$output>. Otherwise C<$output> will be
cleared before any data is written to it.

=item * A Filename

If C<$output> is a filename and C<Append> is enabled, the file will be
opened in append mode. Otherwise the contents of the file, if any, will be
truncated before any compressed data is written to it.

=item * A Filehandle

If C<$output> is a filehandle, the file pointer will be positioned to the
end of the file via a call to C<seek> before any compressed data is written
to it.  Otherwise the file pointer will not be moved.

=back

This parameter defaults to 0.

=item C<< Merge => 0|1 >>

This option is used to compress input data and append it to an existing
compressed data stream in C<$output>. The end result is a single compressed
data stream stored in C<$output>.

It is a fatal error to attempt to use this option when C<$output> is not an
RFC 1951 data stream.

There are a number of other limitations with the C<Merge> option:

=over 5

=item 1

This module needs to have been built with zlib 1.2.1 or better to work. A
fatal error will be thrown if C<Merge> is used with an older version of
zlib.

=item 2

If C<$output> is a file or a filehandle, it must be seekable.

=back

This parameter defaults to 0.

=item -Level

Defines the compression level used by zlib. The value should either be
a number between 0 and 9 (0 means no compression and 9 is maximum
compression), or one of the symbolic constants defined below.

   Z_NO_COMPRESSION
   Z_BEST_SPEED
   Z_BEST_COMPRESSION
   Z_DEFAULT_COMPRESSION

The default is Z_DEFAULT_COMPRESSION.

Note, these constants are not imported by C<IO::Compress::RawDeflate> by default.

    use IO::Compress::RawDeflate qw(:strategy);
    use IO::Compress::RawDeflate qw(:constants);
    use IO::Compress::RawDeflate qw(:all);

=item -Strategy

Defines the strategy used to tune the compression. Use one of the symbolic
constants defined below.

   Z_FILTERED
   Z_HUFFMAN_ONLY
   Z_RLE
   Z_FIXED
   Z_DEFAULT_STRATEGY

The default is Z_DEFAULT_STRATEGY.

=item C<< Strict => 0|1 >>

This is a placeholder option.

=back

=head2 Examples

TODO

=head1 Methods

=head2 print

Usage is

    $z->print($data)
    print $z $data

Compresses and outputs the contents of the C<$data> parameter. This
has the same behaviour as the C<print> built-in.

Returns true if successful.

=head2 printf

Usage is

    $z->printf($format, $data)
    printf $z $format, $data

Compresses and outputs the contents of the C<$data> parameter.

Returns true if successful.

=head2 syswrite

Usage is

    $z->syswrite $data
    $z->syswrite $data, $length
    $z->syswrite $data, $length, $offset

Compresses and outputs the contents of the C<$data> parameter.

Returns the number of uncompressed bytes written, or C<undef> if
unsuccessful.

=head2 write

Usage is

    $z->write $data
    $z->write $data, $length
    $z->write $data, $length, $offset

Compresses and outputs the contents of the C<$data> parameter.

Returns the number of uncompressed bytes written, or C<undef> if
unsuccessful.

=head2 flush

Usage is

    $z->flush;
    $z->flush($flush_type);

Flushes any pending compressed data to the output file/buffer.

This method takes an optional parameter, C<$flush_type>, that controls
how the flushing will be carried out. By default the C<$flush_type>
used is C<Z_FINISH>. Other valid values for C<$flush_type> are
C<Z_NO_FLUSH>, C<Z_SYNC_FLUSH>, C<Z_FULL_FLUSH> and C<Z_BLOCK>. It is
strongly recommended that you only set the C<flush_type> parameter if
you fully understand the implications of what it does - overuse of C<flush>
can seriously degrade the level of compression achieved. See the C<zlib>
documentation for details.

Returns true on success.

=head2 tell

Usage is

    $z->tell()
    tell $z

Returns the uncompressed file offset.

=head2 eof

Usage is

    $z->eof();
    eof($z);

Returns true if the C<close> method has been called.

=head2 seek

    $z->seek($position, $whence);
    seek($z, $position, $whence);

Provides a sub-set of the C<seek> functionality, with the restriction
that it is only legal to seek forward in the output file/buffer.
It is a fatal error to attempt to seek backward.

Empty parts of the file/buffer will have NULL (0x00) bytes written to them.

The C<$whence> parameter takes one the usual values, namely SEEK_SET,
SEEK_CUR or SEEK_END.

Returns 1 on success, 0 on failure.

=head2 binmode

Usage is

    $z->binmode
    binmode $z ;

This is a noop provided for completeness.

=head2 opened

    $z->opened()

Returns true if the object currently refers to a opened file/buffer.

=head2 autoflush

    my $prev = $z->autoflush()
    my $prev = $z->autoflush(EXPR)

If the C<$z> object is associated with a file or a filehandle, this method
returns the current autoflush setting for the underlying filehandle. If
C<EXPR> is present, and is non-zero, it will enable flushing after every
write/print operation.

If C<$z> is associated with a buffer, this method has no effect and always
returns C<undef>.

B<Note> that the special variable C<$|> B<cannot> be used to set or
retrieve the autoflush setting.

=head2 input_line_number

    $z->input_line_number()
    $z->input_line_number(EXPR)

This method always returns C<undef> when compressing.

=head2 fileno

    $z->fileno()
    fileno($z)

If the C<$z> object is associated with a file or a filehandle, C<fileno>
will return the underlying file descriptor. Once the C<close> method is
called C<fileno> will return C<undef>.

If the C<$z> object is associated with a buffer, this method will return
C<undef>.

=head2 close

    $z->close() ;
    close $z ;

Flushes any pending compressed data and then closes the output file/buffer.

For most versions of Perl this method will be automatically invoked if
the IO::Compress::RawDeflate object is destroyed (either explicitly or by the
variable with the reference to the object going out of scope). The
exceptions are Perl versions 5.005 through 5.00504 and 5.8.0. In
these cases, the C<close> method will be called automatically, but
not until global destruction of all live objects when the program is
terminating.

Therefore, if you want your scripts to be able to run on all versions
of Perl, you should call C<close> explicitly and not rely on automatic
closing.

Returns true on success, otherwise 0.

If the C<AutoClose> option has been enabled when the IO::Compress::RawDeflate
object was created, and the object is associated with a file, the
underlying file will also be closed.

=head2 newStream([OPTS])

Usage is

    $z->newStream( [OPTS] )

Closes the current compressed data stream and starts a new one.

OPTS consists of any of the options that are available when creating
the C<$z> object.

See the L</"Constructor Options"> section for more details.

=head2 deflateParams

Usage is

    $z->deflateParams

TODO

=head1 Importing

A number of symbolic constants are required by some methods in
C<IO::Compress::RawDeflate>. None are imported by default.

=over 5

=item :all

Imports C<rawdeflate>, C<$RawDeflateError> and all symbolic
constants that can be used by C<IO::Compress::RawDeflate>. Same as doing this

    use IO::Compress::RawDeflate qw(rawdeflate $RawDeflateError :constants) ;

=item :constants

Import all symbolic constants. Same as doing this

    use IO::Compress::RawDeflate qw(:flush :level :strategy) ;

=item :flush

These symbolic constants are used by the C<flush> method.

    Z_NO_FLUSH
    Z_PARTIAL_FLUSH
    Z_SYNC_FLUSH
    Z_FULL_FLUSH
    Z_FINISH
    Z_BLOCK

=item :level

These symbolic constants are used by the C<Level> option in the constructor.

    Z_NO_COMPRESSION
    Z_BEST_SPEED
    Z_BEST_COMPRESSION
    Z_DEFAULT_COMPRESSION

=item :strategy

These symbolic constants are used by the C<Strategy> option in the constructor.

    Z_FILTERED
    Z_HUFFMAN_ONLY
    Z_RLE
    Z_FIXED
    Z_DEFAULT_STRATEGY

=back

=head1 EXAMPLES

=head2 Apache::GZip Revisited

See L<IO::Compress::FAQ|IO::Compress::FAQ/"Apache::GZip Revisited">

=head2 Working with Net::FTP

See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP">

=head1 SUPPORT

General feedback/questions/bug reports should be sent to
L<https://github.com/pmqs/IO-Compress/issues> (preferred) or
L<https://rt.cpan.org/Public/Dist/Display.html?Name=IO-Compress>.

=head1 SEE ALSO

L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzip>, L<IO::Uncompress::UnLzip>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Compress::Zstd>, L<IO::Uncompress::UnZstd>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>

L<IO::Compress::FAQ|IO::Compress::FAQ>

L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>,
L<Archive::Tar|Archive::Tar>,
L<IO::Zlib|IO::Zlib>

For RFC 1950, 1951 and 1952 see
L<http://www.faqs.org/rfcs/rfc1950.html>,
L<http://www.faqs.org/rfcs/rfc1951.html> and
L<http://www.faqs.org/rfcs/rfc1952.html>

The I<zlib> compression library was written by Jean-loup Gailly
C<gzip@prep.ai.mit.edu> and Mark Adler C<madler@alumni.caltech.edu>.

The primary site for the I<zlib> compression library is
L<http://www.zlib.org>.

The primary site for gzip is L<http://www.gzip.org>.

=head1 AUTHOR

This module was written by Paul Marquess, C<pmqs@cpan.org>.

=head1 MODIFICATION HISTORY

See the Changes file.

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2005-2021 Paul Marquess. All rights reserved.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
                                                                                                                                                                                                                                           Zlib.pm                                                                                             0000644                 00000037345 00000000000 0005757 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       # IO::Zlib.pm
#
# Copyright (c) 1998-2004 Tom Hughes <tom@compton.nu>.
# All rights reserved. This program is free software; you can redistribute
# it and/or modify it under the same terms as Perl itself.

package IO::Zlib;

=head1 NAME

IO::Zlib - IO:: style interface to L<Compress::Zlib>

=head1 SYNOPSIS

With any version of Perl 5 you can use the basic OO interface:

    use IO::Zlib;

    $fh = new IO::Zlib;
    if ($fh->open("file.gz", "rb")) {
        print <$fh>;
        $fh->close;
    }

    $fh = IO::Zlib->new("file.gz", "wb9");
    if (defined $fh) {
        print $fh "bar\n";
        $fh->close;
    }

    $fh = IO::Zlib->new("file.gz", "rb");
    if (defined $fh) {
        print <$fh>;
        undef $fh;       # automatically closes the file
    }

With Perl 5.004 you can also use the TIEHANDLE interface to access
compressed files just like ordinary files:

    use IO::Zlib;

    tie *FILE, 'IO::Zlib', "file.gz", "wb";
    print FILE "line 1\nline2\n";

    tie *FILE, 'IO::Zlib', "file.gz", "rb";
    while (<FILE>) { print "LINE: ", $_ };

=head1 DESCRIPTION

C<IO::Zlib> provides an IO:: style interface to L<Compress::Zlib> and
hence to gzip/zlib compressed files. It provides many of the same methods
as the L<IO::Handle> interface.

Starting from IO::Zlib version 1.02, IO::Zlib can also use an
external F<gzip> command.  The default behaviour is to try to use
an external F<gzip> if no C<Compress::Zlib> can be loaded, unless
explicitly disabled by

    use IO::Zlib qw(:gzip_external 0);

If explicitly enabled by

    use IO::Zlib qw(:gzip_external 1);

then the external F<gzip> is used B<instead> of C<Compress::Zlib>.

=head1 CONSTRUCTOR

=over 4

=item new ( [ARGS] )

Creates an C<IO::Zlib> object. If it receives any parameters, they are
passed to the method C<open>; if the open fails, the object is destroyed.
Otherwise, it is returned to the caller.

=back

=head1 OBJECT METHODS

=over 4

=item open ( FILENAME, MODE )

C<open> takes two arguments. The first is the name of the file to open
and the second is the open mode. The mode can be anything acceptable to
L<Compress::Zlib> and by extension anything acceptable to I<zlib> (that
basically means POSIX fopen() style mode strings plus an optional number
to indicate the compression level).

=item opened

Returns true if the object currently refers to a opened file.

=item close

Close the file associated with the object and disassociate
the file from the handle.
Done automatically on destroy.

=item getc

Return the next character from the file, or undef if none remain.

=item getline

Return the next line from the file, or undef on end of string.
Can safely be called in an array context.
Currently ignores $/ ($INPUT_RECORD_SEPARATOR or $RS when L<English>
is in use) and treats lines as delimited by "\n".

=item getlines

Get all remaining lines from the file.
It will croak() if accidentally called in a scalar context.

=item print ( ARGS... )

Print ARGS to the  file.

=item read ( BUF, NBYTES, [OFFSET] )

Read some bytes from the file.
Returns the number of bytes actually read, 0 on end-of-file, undef on error.

=item eof

Returns true if the handle is currently positioned at end of file?

=item seek ( OFFSET, WHENCE )

Seek to a given position in the stream.
Not yet supported.

=item tell

Return the current position in the stream, as a numeric offset.
Not yet supported.

=item setpos ( POS )

Set the current position, using the opaque value returned by C<getpos()>.
Not yet supported.

=item getpos ( POS )

Return the current position in the string, as an opaque object.
Not yet supported.

=back

=head1 USING THE EXTERNAL GZIP

If the external F<gzip> is used, the following C<open>s are used:

    open(FH, "gzip -dc $filename |")  # for read opens
    open(FH, " | gzip > $filename")   # for write opens

You can modify the 'commands' for example to hardwire
an absolute path by e.g.

    use IO::Zlib ':gzip_read_open'  => '/some/where/gunzip -c %s |';
    use IO::Zlib ':gzip_write_open' => '| /some/where/gzip.exe > %s';

The C<%s> is expanded to be the filename (C<sprintf> is used, so be
careful to escape any other C<%> signs).  The 'commands' are checked
for sanity - they must contain the C<%s>, and the read open must end
with the pipe sign, and the write open must begin with the pipe sign.

=head1 CLASS METHODS

=over 4

=item has_Compress_Zlib

Returns true if C<Compress::Zlib> is available.  Note that this does
not mean that C<Compress::Zlib> is being used: see L</gzip_external>
and L<gzip_used>.

=item gzip_external

Undef if an external F<gzip> B<can> be used if C<Compress::Zlib> is
not available (see L</has_Compress_Zlib>), true if an external F<gzip>
is explicitly used, false if an external F<gzip> must not be used.
See L</gzip_used>.

=item gzip_used

True if an external F<gzip> is being used, false if not.

=item gzip_read_open

Return the 'command' being used for opening a file for reading using an
external F<gzip>.

=item gzip_write_open

Return the 'command' being used for opening a file for writing using an
external F<gzip>.

=back

=head1 DIAGNOSTICS

=over 4

=item IO::Zlib::getlines: must be called in list context

If you want read lines, you must read in list context.

=item IO::Zlib::gzopen_external: mode '...' is illegal

Use only modes 'rb' or 'wb' or /wb[1-9]/.

=item IO::Zlib::import: '...' is illegal

The known import symbols are the C<:gzip_external>, C<:gzip_read_open>,
and C<:gzip_write_open>.  Anything else is not recognized.

=item IO::Zlib::import: ':gzip_external' requires an argument

The C<:gzip_external> requires one boolean argument.

=item IO::Zlib::import: 'gzip_read_open' requires an argument

The C<:gzip_external> requires one string argument.

=item IO::Zlib::import: 'gzip_read' '...' is illegal

The C<:gzip_read_open> argument must end with the pipe sign (|)
and have the C<%s> for the filename.  See L</"USING THE EXTERNAL GZIP">.

=item IO::Zlib::import: 'gzip_write_open' requires an argument

The C<:gzip_external> requires one string argument.

=item IO::Zlib::import: 'gzip_write_open' '...' is illegal

The C<:gzip_write_open> argument must begin with the pipe sign (|)
and have the C<%s> for the filename.  An output redirect (>) is also
often a good idea, depending on your operating system shell syntax.
See L</"USING THE EXTERNAL GZIP">.

=item IO::Zlib::import: no Compress::Zlib and no external gzip

Given that we failed to load C<Compress::Zlib> and that the use of
 an external F<gzip> was disabled, IO::Zlib has not much chance of working.

=item IO::Zlib::open: needs a filename

No filename, no open.

=item IO::Zlib::READ: NBYTES must be specified

We must know how much to read.

=item IO::Zlib::WRITE: too long LENGTH

The LENGTH must be less than or equal to the buffer size.

=back

=head1 SEE ALSO

L<perlfunc>,
L<perlop/"I/O Operators">,
L<IO::Handle>,
L<Compress::Zlib>

=head1 HISTORY

Created by Tom Hughes E<lt>F<tom@compton.nu>E<gt>.

Support for external gzip added by Jarkko Hietaniemi E<lt>F<jhi@iki.fi>E<gt>.

=head1 COPYRIGHT

Copyright (c) 1998-2004 Tom Hughes E<lt>F<tom@compton.nu>E<gt>.
All rights reserved. This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

=cut

require 5.006;

use strict;
use warnings;

use Carp;
use Fcntl qw(SEEK_SET);
use Symbol;
use Tie::Handle;

our $VERSION = "1.11";
our $AUTOLOAD;
our @ISA = qw(Tie::Handle);

my $has_Compress_Zlib;
my $gzip_external;
my $gzip_used;
my $gzip_read_open = "gzip -dc %s |";
my $gzip_write_open = "| gzip > %s";
my $aliased;

BEGIN {
    eval { require Compress::Zlib };
    $has_Compress_Zlib = $@ || $Compress::Zlib::VERSION < 2.000 ? 0 : 1;
}

sub has_Compress_Zlib
{
    $has_Compress_Zlib;
}

sub gzip_external
{
    $gzip_external;
}

sub gzip_used
{
    $gzip_used;
}

sub gzip_read_open
{
    $gzip_read_open;
}

sub gzip_write_open
{
    $gzip_write_open;
}

sub can_gunzip
{
    $has_Compress_Zlib || $gzip_external;
}

sub _import
{
    my $import = shift;

    while (@_)
    {
        if ($_[0] eq ':gzip_external')
        {
            shift;

            if (@_)
            {
                $gzip_external = shift;
            }
            else
            {
                croak "$import: ':gzip_external' requires an argument";
            }
        }
        elsif ($_[0] eq ':gzip_read_open')
        {
            shift;

            if (@_)
            {
                $gzip_read_open = shift;

                croak "$import: ':gzip_read_open' '$gzip_read_open' is illegal"
                    unless $gzip_read_open =~ /^.+%s.+\|\s*$/;
            }
            else
            {
                croak "$import: ':gzip_read_open' requires an argument";
            }
        }
        elsif ($_[0] eq ':gzip_write_open')
        {
            shift;

            if (@_)
            {
                $gzip_write_open = shift;

                croak "$import: ':gzip_write_open' '$gzip_read_open' is illegal"
                    unless $gzip_write_open =~ /^\s*\|.+%s.*$/;
            }
            else
            {
                croak "$import: ':gzip_write_open' requires an argument";
            }
        }
        else
        {
            last;
        }
    }

    return @_;
}

sub _alias
{
    my $import = shift;

    if ($gzip_external || (!$has_Compress_Zlib && !defined($gzip_external)))
    {
        require IO::Handle;

        undef *gzopen;
        *gzopen = \&gzopen_external;

        *IO::Handle::gzread = \&gzread_external;
        *IO::Handle::gzwrite = \&gzwrite_external;
        *IO::Handle::gzreadline = \&gzreadline_external;
        *IO::Handle::gzeof = \&gzeof_external;
        *IO::Handle::gzclose = \&gzclose_external;

        $gzip_used = 1;
    }
    elsif ($has_Compress_Zlib)
    {
        *gzopen = \&Compress::Zlib::gzopen;
        *gzread = \&Compress::Zlib::gzread;
        *gzwrite = \&Compress::Zlib::gzwrite;
        *gzreadline = \&Compress::Zlib::gzreadline;
        *gzeof = \&Compress::Zlib::gzeof;
    }
    else
    {
        croak "$import: no Compress::Zlib and no external gzip";
    }

    $aliased = 1;
}

sub import
{
    my $class = shift;
    my $import = "IO::Zlib::import";

    if (@_)
    {
        if (_import($import, @_))
        {
            croak "$import: '@_' is illegal";
        }
    }

    _alias($import);
}

sub TIEHANDLE
{
    my $class = shift;
    my @args = @_;

    my $self = bless {}, $class;

    return @args ? $self->OPEN(@args) : $self;
}

sub DESTROY
{
}

sub OPEN
{
    my $self = shift;
    my $filename = shift;
    my $mode = shift;

    croak "IO::Zlib::open: needs a filename" unless defined($filename);

    $self->{'file'} = gzopen($filename,$mode);

    return defined($self->{'file'}) ? $self : undef;
}

sub CLOSE
{
    my $self = shift;

    return undef unless defined($self->{'file'});

    my $status = $self->{'file'}->gzclose();

    delete $self->{'file'};

    return ($status == 0) ? 1 : undef;
}

sub READ
{
    my $self = shift;
    my $bufref = \$_[0];
    my $nbytes = $_[1];
    my $offset = $_[2] || 0;

    croak "IO::Zlib::READ: NBYTES must be specified" unless defined($nbytes);

    $$bufref = "" unless defined($$bufref);

    my $bytesread = $self->{'file'}->gzread(substr($$bufref,$offset),$nbytes);

    return undef if $bytesread < 0;

    return $bytesread;
}

sub READLINE
{
    my $self = shift;

    my $line;

    return () if $self->{'file'}->gzreadline($line) <= 0;

    return $line unless wantarray;

    my @lines = $line;

    while ($self->{'file'}->gzreadline($line) > 0)
    {
        push @lines, $line;
    }

    return @lines;
}

sub WRITE
{
    my $self = shift;
    my $buf = shift;
    my $length = shift;
    my $offset = shift;

    croak "IO::Zlib::WRITE: too long LENGTH" unless $offset + $length <= length($buf);

    return $self->{'file'}->gzwrite(substr($buf,$offset,$length));
}

sub EOF
{
    my $self = shift;

    return $self->{'file'}->gzeof();
}

sub FILENO
{
    return undef;
}

sub new
{
    my $class = shift;
    my @args = @_;

    _alias("new", @_) unless $aliased; # Some call new IO::Zlib directly...

    my $self = gensym();

    tie *{$self}, $class, @args;

    return tied(${$self}) ? bless $self, $class : undef;
}

sub getline
{
    my $self = shift;

    return scalar tied(*{$self})->READLINE();
}

sub getlines
{
    my $self = shift;

    croak "IO::Zlib::getlines: must be called in list context"
        unless wantarray;

    return tied(*{$self})->READLINE();
}

sub opened
{
    my $self = shift;

    return defined tied(*{$self})->{'file'};
}

sub AUTOLOAD
{
    my $self = shift;

    $AUTOLOAD =~ s/.*:://;
    $AUTOLOAD =~ tr/a-z/A-Z/;

    return tied(*{$self})->$AUTOLOAD(@_);
}

sub gzopen_external
{
    my $filename = shift;
    my $mode = shift;
    my $fh = IO::Handle->new();

    if ($mode =~ /r/)
    {
        # Because someone will try to read ungzipped files
        # with this we peek and verify the signature.  Yes,
        # this means that we open the file twice (if it is
        # gzipped).
        # Plenty of race conditions exist in this code, but
        # the alternative would be to capture the stderr of
        # gzip and parse it, which would be a portability nightmare.
        if (-e $filename && open($fh, $filename))
        {
            binmode $fh;

            my $sig;
            my $rdb = read($fh, $sig, 2);

            if ($rdb == 2 && $sig eq "\x1F\x8B")
            {
                my $ropen = sprintf($gzip_read_open, $filename);

                if (open($fh, $ropen))
                {
                    binmode $fh;

                    return $fh;
                }
                else
                {
                    return undef;
                }
            }

            seek($fh, 0, SEEK_SET) or
                die "IO::Zlib: open('$filename', 'r'): seek: $!";

            return $fh;
        }
        else
        {
            return undef;
        }
    }
    elsif ($mode =~ /w/)
    {
        my $level = $mode =~ /([1-9])/ ? "-$1" : "";

        # To maximize portability we would need to open
        # two filehandles here, one for "| gzip $level"
        # and another for "> $filename", and then when
        # writing copy bytes from the first to the second.
        # We are using IO::Handle objects for now, however,
        # and they can only contain one stream at a time.
        my $wopen = sprintf($gzip_write_open, $filename);

        if (open($fh, $wopen))
        {
            $fh->autoflush(1);
            binmode $fh;

            return $fh;
        }
        else
        {
            return undef;
        }
    }
    else
    {
        croak "IO::Zlib::gzopen_external: mode '$mode' is illegal";
    }

    return undef;
}

sub gzread_external
{
    my $file = shift;
    my $bufref = \$_[0];
    my $nbytes = $_[1] || 4096;

    # Use read() instead of sysread() because people may
    # mix reads and readlines, and we don't want to mess
    # the stdio buffering.  See also gzreadline_external()
    # and gzwrite_external().
    my $nread = read($file, $$bufref, $nbytes);

    return defined $nread ? $nread : -1;
}

sub gzwrite_external
{
    my $file = shift;
    my $buf = shift;

    # Using syswrite() is okay (cf. gzread_external())
    # since the bytes leave this process and buffering
    # is therefore not an issue.
    my $nwrote = syswrite($file, $buf);

    return defined $nwrote ? $nwrote : -1;
}

sub gzreadline_external
{
    my $file = shift;
    my $bufref = \$_[0];

    # See the comment in gzread_external().
    $$bufref = readline($file);

    return defined $$bufref ? length($$bufref) : -1;
}

sub gzeof_external
{
    my $file = shift;

    return eof($file);
}

sub gzclose_external
{
    my $file = shift;

    close($file);

    # I am not entirely certain why this is needed but it seems
    # the above close() always fails (as if the stream would have
    # been already closed - something to do with using external
    # processes via pipes?)
    return 0;
}

1;
                                                                                                                                                                                                                                                                                           Uncompress/Unzip.pm                                                                                 0000644                 00000156031 00000000000 0010314 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       package IO::Uncompress::Unzip;

require 5.006 ;

# for RFC1952

use strict ;
use warnings;
use bytes;

use IO::File;
use IO::Uncompress::RawInflate  2.101 ;
use IO::Compress::Base::Common  2.101 qw(:Status );
use IO::Uncompress::Adapter::Inflate  2.101 ;
use IO::Uncompress::Adapter::Identity 2.101 ;
use IO::Compress::Zlib::Extra 2.101 ;
use IO::Compress::Zip::Constants 2.101 ;

use Compress::Raw::Zlib  2.101 () ;

BEGIN
{
   # Don't trigger any __DIE__ Hooks.
   local $SIG{__DIE__};

    eval{ require IO::Uncompress::Adapter::Bunzip2 ;
          IO::Uncompress::Adapter::Bunzip2->import() } ;
    eval{ require IO::Uncompress::Adapter::UnLzma ;
          IO::Uncompress::Adapter::UnLzma->import() } ;
    eval{ require IO::Uncompress::Adapter::UnXz ;
          IO::Uncompress::Adapter::UnXz->import() } ;
    eval{ require IO::Uncompress::Adapter::UnZstd ;
          IO::Uncompress::Adapter::UnZstd->import() } ;
}


require Exporter ;

our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $UnzipError, %headerLookup);

$VERSION = '2.102';
$UnzipError = '';

@ISA    = qw(IO::Uncompress::RawInflate Exporter);
@EXPORT_OK = qw( $UnzipError unzip );
%EXPORT_TAGS = %IO::Uncompress::RawInflate::EXPORT_TAGS ;
push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
Exporter::export_ok_tags('all');

%headerLookup = (
        ZIP_CENTRAL_HDR_SIG,            \&skipCentralDirectory,
        ZIP_END_CENTRAL_HDR_SIG,        \&skipEndCentralDirectory,
        ZIP64_END_CENTRAL_REC_HDR_SIG,  \&skipCentralDirectory64Rec,
        ZIP64_END_CENTRAL_LOC_HDR_SIG,  \&skipCentralDirectory64Loc,
        ZIP64_ARCHIVE_EXTRA_SIG,        \&skipArchiveExtra,
        ZIP64_DIGITAL_SIGNATURE_SIG,    \&skipDigitalSignature,
        );

my %MethodNames = (
        ZIP_CM_DEFLATE()    => 'Deflated',
        ZIP_CM_BZIP2()      => 'Bzip2',
        ZIP_CM_LZMA()       => 'Lzma',
        ZIP_CM_STORE()      => 'Stored',
        ZIP_CM_XZ()         => 'Xz',
        ZIP_CM_ZSTD()       => 'Zstd',
    );

sub new
{
    my $class = shift ;
    my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$UnzipError);
    $obj->_create(undef, 0, @_);
}

sub unzip
{
    my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$UnzipError);
    return $obj->_inf(@_) ;
}

sub getExtraParams
{

    return (
#            # Zip header fields
            'name'    => [IO::Compress::Base::Common::Parse_any,       undef],

            'stream'  => [IO::Compress::Base::Common::Parse_boolean,   0],
            'efs'     => [IO::Compress::Base::Common::Parse_boolean,   0],

            # TODO - This means reading the central directory to get
            # 1. the local header offsets
            # 2. The compressed data length
        );
}

sub ckParams
{
    my $self = shift ;
    my $got = shift ;

    # unzip always needs crc32
    $got->setValue('crc32' => 1);

    *$self->{UnzipData}{Name} = $got->getValue('name');
    *$self->{UnzipData}{efs} = $got->getValue('efs');

    return 1;
}

sub mkUncomp
{
    my $self = shift ;
    my $got = shift ;

     my $magic = $self->ckMagic()
        or return 0;

    *$self->{Info} = $self->readHeader($magic)
        or return undef ;

    return 1;

}

sub ckMagic
{
    my $self = shift;

    my $magic ;
    $self->smartReadExact(\$magic, 4);

    *$self->{HeaderPending} = $magic ;

    return $self->HeaderError("Minimum header size is " .
                              4 . " bytes")
        if length $magic != 4 ;

    return $self->HeaderError("Bad Magic")
        if ! _isZipMagic($magic) ;

    *$self->{Type} = 'zip';

    return $magic ;
}


sub fastForward
{
    my $self = shift;
    my $offset = shift;

    # TODO - if Stream isn't enabled & reading from file, use seek

    my $buffer = '';
    my $c = 1024 * 16;

    while ($offset > 0)
    {
        $c = length $offset
            if length $offset < $c ;

        $offset -= $c;

        $self->smartReadExact(\$buffer, $c)
            or return 0;
    }

    return 1;
}


sub readHeader
{
    my $self = shift;
    my $magic = shift ;

    my $name =  *$self->{UnzipData}{Name} ;
    my $hdr = $self->_readZipHeader($magic) ;

    while (defined $hdr)
    {
        if (! defined $name || $hdr->{Name} eq $name)
        {
            return $hdr ;
        }

        # skip the data
        # TODO - when Stream is off, use seek
        my $buffer;
        if (*$self->{ZipData}{Streaming}) {
            while (1) {

                my $b;
                my $status = $self->smartRead(\$b, 1024 * 16);

                return $self->saveErrorString(undef, "Truncated file")
                    if $status <= 0 ;

                my $temp_buf ;
                my $out;

                $status = *$self->{Uncomp}->uncompr(\$b, \$temp_buf, 0, $out);

                return $self->saveErrorString(undef, *$self->{Uncomp}{Error},
                                                     *$self->{Uncomp}{ErrorNo})
                    if $self->saveStatus($status) == STATUS_ERROR;

                $self->pushBack($b)  ;

                if ($status == STATUS_ENDSTREAM) {
                    *$self->{Uncomp}->reset();
                    last;
                }
            }

            # skip the trailer
            $self->smartReadExact(\$buffer, $hdr->{TrailerLength})
                or return $self->saveErrorString(undef, "Truncated file");
        }
        else {
            my $c = $hdr->{CompressedLength}->get64bit();
            $self->fastForward($c)
                or return $self->saveErrorString(undef, "Truncated file");
            $buffer = '';
        }

        $self->chkTrailer($buffer) == STATUS_OK
            or return $self->saveErrorString(undef, "Truncated file");

        $hdr = $self->_readFullZipHeader();

        return $self->saveErrorString(undef, "Cannot find '$name'")
            if $self->smartEof();
    }

    return undef;
}

sub chkTrailer
{
    my $self = shift;
    my $trailer = shift;

    my ($sig, $CRC32, $cSize, $uSize) ;
    my ($cSizeHi, $uSizeHi) = (0, 0);
    if (*$self->{ZipData}{Streaming}) {
        $sig   = unpack ("V", substr($trailer, 0, 4));
        $CRC32 = unpack ("V", substr($trailer, 4, 4));

        if (*$self->{ZipData}{Zip64} ) {
            $cSize = U64::newUnpack_V64 substr($trailer,  8, 8);
            $uSize = U64::newUnpack_V64 substr($trailer, 16, 8);
        }
        else {
            $cSize = U64::newUnpack_V32 substr($trailer,  8, 4);
            $uSize = U64::newUnpack_V32 substr($trailer, 12, 4);
        }

        return $self->TrailerError("Data Descriptor signature, got $sig")
            if $sig != ZIP_DATA_HDR_SIG;
    }
    else {
        ($CRC32, $cSize, $uSize) =
            (*$self->{ZipData}{Crc32},
             *$self->{ZipData}{CompressedLen},
             *$self->{ZipData}{UnCompressedLen});
    }

    *$self->{Info}{CRC32} = *$self->{ZipData}{CRC32} ;
    *$self->{Info}{CompressedLength} = $cSize->get64bit();
    *$self->{Info}{UncompressedLength} = $uSize->get64bit();

    if (*$self->{Strict}) {
        return $self->TrailerError("CRC mismatch")
            if $CRC32  != *$self->{ZipData}{CRC32} ;

        return $self->TrailerError("CSIZE mismatch.")
            if ! $cSize->equal(*$self->{CompSize});

        return $self->TrailerError("USIZE mismatch.")
            if ! $uSize->equal(*$self->{UnCompSize});
    }

    my $reachedEnd = STATUS_ERROR ;
    # check for central directory or end of central directory
    while (1)
    {
        my $magic ;
        my $got = $self->smartRead(\$magic, 4);

        return $self->saveErrorString(STATUS_ERROR, "Truncated file")
            if $got != 4 && *$self->{Strict};

        if ($got == 0) {
            return STATUS_EOF ;
        }
        elsif ($got < 0) {
            return STATUS_ERROR ;
        }
        elsif ($got < 4) {
            $self->pushBack($magic)  ;
            return STATUS_OK ;
        }

        my $sig = unpack("V", $magic) ;

        my $hdr;
        if ($hdr = $headerLookup{$sig})
        {
            if (&$hdr($self, $magic) != STATUS_OK ) {
                if (*$self->{Strict}) {
                    return STATUS_ERROR ;
                }
                else {
                    $self->clearError();
                    return STATUS_OK ;
                }
            }

            if ($sig == ZIP_END_CENTRAL_HDR_SIG)
            {
                return STATUS_OK ;
                last;
            }
        }
        elsif ($sig == ZIP_LOCAL_HDR_SIG)
        {
            $self->pushBack($magic)  ;
            return STATUS_OK ;
        }
        else
        {
            # put the data back
            $self->pushBack($magic)  ;
            last;
        }
    }

    return $reachedEnd ;
}

sub skipCentralDirectory
{
    my $self = shift;
    my $magic = shift ;

    my $buffer;
    $self->smartReadExact(\$buffer, 46 - 4)
        or return $self->TrailerError("Minimum header size is " .
                                     46 . " bytes") ;

    my $keep = $magic . $buffer ;
    *$self->{HeaderPending} = $keep ;

   #my $versionMadeBy      = unpack ("v", substr($buffer, 4-4,  2));
   #my $extractVersion     = unpack ("v", substr($buffer, 6-4,  2));
   #my $gpFlag             = unpack ("v", substr($buffer, 8-4,  2));
   #my $compressedMethod   = unpack ("v", substr($buffer, 10-4, 2));
   #my $lastModTime        = unpack ("V", substr($buffer, 12-4, 4));
   #my $crc32              = unpack ("V", substr($buffer, 16-4, 4));
    my $compressedLength   = unpack ("V", substr($buffer, 20-4, 4));
    my $uncompressedLength = unpack ("V", substr($buffer, 24-4, 4));
    my $filename_length    = unpack ("v", substr($buffer, 28-4, 2));
    my $extra_length       = unpack ("v", substr($buffer, 30-4, 2));
    my $comment_length     = unpack ("v", substr($buffer, 32-4, 2));
   #my $disk_start         = unpack ("v", substr($buffer, 34-4, 2));
   #my $int_file_attrib    = unpack ("v", substr($buffer, 36-4, 2));
   #my $ext_file_attrib    = unpack ("V", substr($buffer, 38-4, 2));
   #my $lcl_hdr_offset     = unpack ("V", substr($buffer, 42-4, 2));


    my $filename;
    my $extraField;
    my $comment ;
    if ($filename_length)
    {
        $self->smartReadExact(\$filename, $filename_length)
            or return $self->TruncatedTrailer("filename");
        $keep .= $filename ;
    }

    if ($extra_length)
    {
        $self->smartReadExact(\$extraField, $extra_length)
            or return $self->TruncatedTrailer("extra");
        $keep .= $extraField ;
    }

    if ($comment_length)
    {
        $self->smartReadExact(\$comment, $comment_length)
            or return $self->TruncatedTrailer("comment");
        $keep .= $comment ;
    }

    return STATUS_OK ;
}

sub skipArchiveExtra
{
    my $self = shift;
    my $magic = shift ;

    my $buffer;
    $self->smartReadExact(\$buffer, 4)
        or return $self->TrailerError("Minimum header size is " .
                                     4 . " bytes") ;

    my $keep = $magic . $buffer ;

    my $size = unpack ("V", $buffer);

    $self->smartReadExact(\$buffer, $size)
        or return $self->TrailerError("Minimum header size is " .
                                     $size . " bytes") ;

    $keep .= $buffer ;
    *$self->{HeaderPending} = $keep ;

    return STATUS_OK ;
}


sub skipCentralDirectory64Rec
{
    my $self = shift;
    my $magic = shift ;

    my $buffer;
    $self->smartReadExact(\$buffer, 8)
        or return $self->TrailerError("Minimum header size is " .
                                     8 . " bytes") ;

    my $keep = $magic . $buffer ;

    my ($sizeLo, $sizeHi)  = unpack ("V V", $buffer);
    my $size = $sizeHi * U64::MAX32 + $sizeLo;

    $self->fastForward($size)
        or return $self->TrailerError("Minimum header size is " .
                                     $size . " bytes") ;

   #$keep .= $buffer ;
   #*$self->{HeaderPending} = $keep ;

   #my $versionMadeBy      = unpack ("v",   substr($buffer,  0, 2));
   #my $extractVersion     = unpack ("v",   substr($buffer,  2, 2));
   #my $diskNumber         = unpack ("V",   substr($buffer,  4, 4));
   #my $cntrlDirDiskNo     = unpack ("V",   substr($buffer,  8, 4));
   #my $entriesInThisCD    = unpack ("V V", substr($buffer, 12, 8));
   #my $entriesInCD        = unpack ("V V", substr($buffer, 20, 8));
   #my $sizeOfCD           = unpack ("V V", substr($buffer, 28, 8));
   #my $offsetToCD         = unpack ("V V", substr($buffer, 36, 8));

    return STATUS_OK ;
}

sub skipCentralDirectory64Loc
{
    my $self = shift;
    my $magic = shift ;

    my $buffer;
    $self->smartReadExact(\$buffer, 20 - 4)
        or return $self->TrailerError("Minimum header size is " .
                                     20 . " bytes") ;

    my $keep = $magic . $buffer ;
    *$self->{HeaderPending} = $keep ;

   #my $startCdDisk        = unpack ("V",   substr($buffer,  4-4, 4));
   #my $offsetToCD         = unpack ("V V", substr($buffer,  8-4, 8));
   #my $diskCount          = unpack ("V",   substr($buffer, 16-4, 4));

    return STATUS_OK ;
}

sub skipEndCentralDirectory
{
    my $self = shift;
    my $magic = shift ;


    my $buffer;
    $self->smartReadExact(\$buffer, 22 - 4)
        or return $self->TrailerError("Minimum header size is " .
                                     22 . " bytes") ;

    my $keep = $magic . $buffer ;
    *$self->{HeaderPending} = $keep ;

   #my $diskNumber         = unpack ("v", substr($buffer, 4-4,  2));
   #my $cntrlDirDiskNo     = unpack ("v", substr($buffer, 6-4,  2));
   #my $entriesInThisCD    = unpack ("v", substr($buffer, 8-4,  2));
   #my $entriesInCD        = unpack ("v", substr($buffer, 10-4, 2));
   #my $sizeOfCD           = unpack ("V", substr($buffer, 12-4, 4));
   #my $offsetToCD         = unpack ("V", substr($buffer, 16-4, 4));
    my $comment_length     = unpack ("v", substr($buffer, 20-4, 2));


    my $comment ;
    if ($comment_length)
    {
        $self->smartReadExact(\$comment, $comment_length)
            or return $self->TruncatedTrailer("comment");
        $keep .= $comment ;
    }

    return STATUS_OK ;
}


sub _isZipMagic
{
    my $buffer = shift ;
    return 0 if length $buffer < 4 ;
    my $sig = unpack("V", $buffer) ;
    return $sig == ZIP_LOCAL_HDR_SIG ;
}


sub _readFullZipHeader($)
{
    my ($self) = @_ ;
    my $magic = '' ;

    $self->smartReadExact(\$magic, 4);

    *$self->{HeaderPending} = $magic ;

    return $self->HeaderError("Minimum header size is " .
                              30 . " bytes")
        if length $magic != 4 ;


    return $self->HeaderError("Bad Magic")
        if ! _isZipMagic($magic) ;

    my $status = $self->_readZipHeader($magic);
    delete *$self->{Transparent} if ! defined $status ;
    return $status ;
}

sub _readZipHeader($)
{
    my ($self, $magic) = @_ ;
    my ($HeaderCRC) ;
    my ($buffer) = '' ;

    $self->smartReadExact(\$buffer, 30 - 4)
        or return $self->HeaderError("Minimum header size is " .
                                     30 . " bytes") ;

    my $keep = $magic . $buffer ;
    *$self->{HeaderPending} = $keep ;

    my $extractVersion     = unpack ("v", substr($buffer, 4-4,  2));
    my $gpFlag             = unpack ("v", substr($buffer, 6-4,  2));
    my $compressedMethod   = unpack ("v", substr($buffer, 8-4,  2));
    my $lastModTime        = unpack ("V", substr($buffer, 10-4, 4));
    my $crc32              = unpack ("V", substr($buffer, 14-4, 4));
    my $compressedLength   = U64::newUnpack_V32 substr($buffer, 18-4, 4);
    my $uncompressedLength = U64::newUnpack_V32 substr($buffer, 22-4, 4);
    my $filename_length    = unpack ("v", substr($buffer, 26-4, 2));
    my $extra_length       = unpack ("v", substr($buffer, 28-4, 2));

    my $filename;
    my $extraField;
    my @EXTRA = ();

    # Some programs (some versions of LibreOffice) mark entries as streamed, but still fill out
    # compressedLength/uncompressedLength & crc32 in the local file header.
    # The expected data descriptor is not populated.
    # So only assume streaming if the Streaming bit is set AND the compressed length is zero
    my $streamingMode = (($gpFlag & ZIP_GP_FLAG_STREAMING_MASK)  && $crc32 == 0) ? 1 : 0 ;

    my $efs_flag = ($gpFlag & ZIP_GP_FLAG_LANGUAGE_ENCODING) ? 1 : 0;

    return $self->HeaderError("Encrypted content not supported")
        if $gpFlag & (ZIP_GP_FLAG_ENCRYPTED_MASK|ZIP_GP_FLAG_STRONG_ENCRYPTED_MASK);

    return $self->HeaderError("Patch content not supported")
        if $gpFlag & ZIP_GP_FLAG_PATCHED_MASK;

    *$self->{ZipData}{Streaming} = $streamingMode;


    if ($filename_length)
    {
        $self->smartReadExact(\$filename, $filename_length)
            or return $self->TruncatedHeader("Filename");

        if (*$self->{UnzipData}{efs} && $efs_flag && $] >= 5.008004)
        {
            require Encode;
            eval { $filename = Encode::decode_utf8($filename, 1) }
                or Carp::croak "Zip Filename not UTF-8" ;
        }

        $keep .= $filename ;
    }

    my $zip64 = 0 ;

    if ($extra_length)
    {
        $self->smartReadExact(\$extraField, $extra_length)
            or return $self->TruncatedHeader("Extra Field");

        my $bad = IO::Compress::Zlib::Extra::parseRawExtra($extraField,
                                                \@EXTRA, 1, 0);
        return $self->HeaderError($bad)
            if defined $bad;

        $keep .= $extraField ;

        my %Extra ;
        for (@EXTRA)
        {
            $Extra{$_->[0]} = \$_->[1];
        }

        if (defined $Extra{ZIP_EXTRA_ID_ZIP64()})
        {
            $zip64 = 1 ;

            my $buff = ${ $Extra{ZIP_EXTRA_ID_ZIP64()} };

            # This code assumes that all the fields in the Zip64
            # extra field aren't necessarily present. The spec says that
            # they only exist if the equivalent local headers are -1.

            if (! $streamingMode) {
                my $offset = 0 ;

                if (U64::full32 $uncompressedLength->get32bit() ) {
                    $uncompressedLength
                            = U64::newUnpack_V64 substr($buff, 0, 8);

                    $offset += 8 ;
                }

                if (U64::full32 $compressedLength->get32bit() ) {

                    $compressedLength
                        = U64::newUnpack_V64 substr($buff, $offset, 8);

                    $offset += 8 ;
                }
           }
        }
    }

    *$self->{ZipData}{Zip64} = $zip64;

    if (! $streamingMode) {
        *$self->{ZipData}{Streaming} = 0;
        *$self->{ZipData}{Crc32} = $crc32;
        *$self->{ZipData}{CompressedLen} = $compressedLength;
        *$self->{ZipData}{UnCompressedLen} = $uncompressedLength;
        *$self->{CompressedInputLengthRemaining} =
            *$self->{CompressedInputLength} = $compressedLength->get64bit();
    }

    *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef);
    *$self->{ZipData}{Method} = $compressedMethod;
    if ($compressedMethod == ZIP_CM_DEFLATE)
    {
        *$self->{Type} = 'zip-deflate';
        my $obj = IO::Uncompress::Adapter::Inflate::mkUncompObject(1,0,0);

        *$self->{Uncomp} = $obj;
    }
    elsif ($compressedMethod == ZIP_CM_BZIP2)
    {
        return $self->HeaderError("Unsupported Compression format $compressedMethod")
            if ! defined $IO::Uncompress::Adapter::Bunzip2::VERSION ;

        *$self->{Type} = 'zip-bzip2';

        my $obj = IO::Uncompress::Adapter::Bunzip2::mkUncompObject();

        *$self->{Uncomp} = $obj;
    }
    elsif ($compressedMethod == ZIP_CM_XZ)
    {
        return $self->HeaderError("Unsupported Compression format $compressedMethod")
            if ! defined $IO::Uncompress::Adapter::UnXz::VERSION ;

        *$self->{Type} = 'zip-xz';

        my $obj = IO::Uncompress::Adapter::UnXz::mkUncompObject();

        *$self->{Uncomp} = $obj;
    }
    elsif ($compressedMethod == ZIP_CM_ZSTD)
    {
        return $self->HeaderError("Unsupported Compression format $compressedMethod")
            if ! defined $IO::Uncompress::Adapter::UnZstd::VERSION ;

        *$self->{Type} = 'zip-zstd';

        my $obj = IO::Uncompress::Adapter::UnZstd::mkUncompObject();

        *$self->{Uncomp} = $obj;
    }
    elsif ($compressedMethod == ZIP_CM_LZMA)
    {
        return $self->HeaderError("Unsupported Compression format $compressedMethod")
            if ! defined $IO::Uncompress::Adapter::UnLzma::VERSION ;

        *$self->{Type} = 'zip-lzma';
        my $LzmaHeader;
        $self->smartReadExact(\$LzmaHeader, 4)
                or return $self->saveErrorString(undef, "Truncated file");
        my ($verHi, $verLo)   = unpack ("CC", substr($LzmaHeader, 0, 2));
        my $LzmaPropertiesSize   = unpack ("v", substr($LzmaHeader, 2, 2));


        my $LzmaPropertyData;
        $self->smartReadExact(\$LzmaPropertyData, $LzmaPropertiesSize)
                or return $self->saveErrorString(undef, "Truncated file");

        if (! $streamingMode) {
            *$self->{ZipData}{CompressedLen}->subtract(4 + $LzmaPropertiesSize) ;
            *$self->{CompressedInputLengthRemaining} =
                *$self->{CompressedInputLength} = *$self->{ZipData}{CompressedLen}->get64bit();
        }

        my $obj =
            IO::Uncompress::Adapter::UnLzma::mkUncompZipObject($LzmaPropertyData);

        *$self->{Uncomp} = $obj;
    }
    elsif ($compressedMethod == ZIP_CM_STORE)
    {
        *$self->{Type} = 'zip-stored';

        my $obj =
        IO::Uncompress::Adapter::Identity::mkUncompObject($streamingMode,
                                                          $zip64);

        *$self->{Uncomp} = $obj;
    }
    else
    {
        return $self->HeaderError("Unsupported Compression format $compressedMethod");
    }

    return {
        'Type'               => 'zip',
        'FingerprintLength'  => 4,
        #'HeaderLength'       => $compressedMethod == 8 ? length $keep : 0,
        'HeaderLength'       => length $keep,
        'Zip64'              => $zip64,
        'TrailerLength'      => ! $streamingMode ? 0 : $zip64 ? 24 : 16,
        'Header'             => $keep,
        'CompressedLength'   => $compressedLength ,
        'UncompressedLength' => $uncompressedLength ,
        'CRC32'              => $crc32 ,
        'Name'               => $filename,
        'efs'                => $efs_flag, # language encoding flag
        'Time'               => _dosToUnixTime($lastModTime),
        'Stream'             => $streamingMode,

        'MethodID'           => $compressedMethod,
        'MethodName'         => $MethodNames{$compressedMethod} || 'Unknown',

#        'TextFlag'      => $flag & GZIP_FLG_FTEXT ? 1 : 0,
#        'HeaderCRCFlag' => $flag & GZIP_FLG_FHCRC ? 1 : 0,
#        'NameFlag'      => $flag & GZIP_FLG_FNAME ? 1 : 0,
#        'CommentFlag'   => $flag & GZIP_FLG_FCOMMENT ? 1 : 0,
#        'ExtraFlag'     => $flag & GZIP_FLG_FEXTRA ? 1 : 0,
#        'Comment'       => $comment,
#        'OsID'          => $os,
#        'OsName'        => defined $GZIP_OS_Names{$os}
#                                 ? $GZIP_OS_Names{$os} : "Unknown",
#        'HeaderCRC'     => $HeaderCRC,
#        'Flags'         => $flag,
#        'ExtraFlags'    => $xfl,
        'ExtraFieldRaw' => $extraField,
        'ExtraField'    => [ @EXTRA ],


      }
}

sub filterUncompressed
{
    my $self = shift ;

    if (*$self->{ZipData}{Method} == ZIP_CM_DEFLATE) {
        *$self->{ZipData}{CRC32} = *$self->{Uncomp}->crc32() ;
    }
    else {
        *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(${$_[0]}, *$self->{ZipData}{CRC32}, $_[1]);
    }
}


# from Archive::Zip & info-zip
sub _dosToUnixTime
{
	my $dt = shift;

	my $year = ( ( $dt >> 25 ) & 0x7f ) + 80;
	my $mon  = ( ( $dt >> 21 ) & 0x0f ) - 1;
	my $mday = ( ( $dt >> 16 ) & 0x1f );

	my $hour = ( ( $dt >> 11 ) & 0x1f );
	my $min  = ( ( $dt >> 5 ) & 0x3f );
	my $sec  = ( ( $dt << 1 ) & 0x3e );


    use POSIX 'mktime';

    my $time_t = mktime( $sec, $min, $hour, $mday, $mon, $year, 0, 0, -1 );
    return 0 if ! defined $time_t;
	return $time_t;
}

#sub scanCentralDirectory
#{
#    # Use cases
#    # 1 32-bit CD
#    # 2 64-bit CD
#
#    my $self = shift ;
#
#    my @CD = ();
#    my $offset = $self->findCentralDirectoryOffset();
#
#    return 0
#        if ! defined $offset;
#
#    $self->smarkSeek($offset, 0, SEEK_SET) ;
#
#    # Now walk the Central Directory Records
#    my $buffer ;
#    while ($self->smartReadExact(\$buffer, 46) &&
#           unpack("V", $buffer) == ZIP_CENTRAL_HDR_SIG) {
#
#        my $compressedLength   = unpack ("V", substr($buffer, 20, 4));
#        my $filename_length    = unpack ("v", substr($buffer, 28, 2));
#        my $extra_length       = unpack ("v", substr($buffer, 30, 2));
#        my $comment_length     = unpack ("v", substr($buffer, 32, 2));
#
#        $self->smarkSeek($filename_length + $extra_length + $comment_length, 0, SEEK_CUR)
#            if $extra_length || $comment_length || $filename_length;
#        push @CD, $compressedLength ;
#    }
#
#}
#
#sub findCentralDirectoryOffset
#{
#    my $self = shift ;
#
#    # Most common use-case is where there is no comment, so
#    # know exactly where the end of central directory record
#    # should be.
#
#    $self->smarkSeek(-22, 0, SEEK_END) ;
#
#    my $buffer;
#    $self->smartReadExact(\$buffer, 22) ;
#
#    my $zip64 = 0;
#    my $centralDirOffset ;
#    if ( unpack("V", $buffer) == ZIP_END_CENTRAL_HDR_SIG ) {
#        $centralDirOffset = unpack ("V", substr($buffer, 16, 2));
#    }
#    else {
#        die "xxxx";
#    }
#
#    return $centralDirOffset ;
#}
#
#sub is84BitCD
#{
#    # TODO
#    my $self = shift ;
#}


sub skip
{
    my $self = shift;
    my $size = shift;

    use Fcntl qw(SEEK_CUR);
    if (ref $size eq 'U64') {
        $self->smartSeek($size->get64bit(), SEEK_CUR);
    }
    else {
        $self->smartSeek($size, SEEK_CUR);
    }

}


sub scanCentralDirectory
{
    my $self = shift;

    my $here = $self->tell();

    # Use cases
    # 1 32-bit CD
    # 2 64-bit CD

    my @CD = ();
    my $offset = $self->findCentralDirectoryOffset();

    return ()
        if ! defined $offset;

    $self->smarkSeek($offset, 0, SEEK_SET) ;

    # Now walk the Central Directory Records
    my $buffer ;
    while ($self->smartReadExact(\$buffer, 46) &&
           unpack("V", $buffer) == ZIP_CENTRAL_HDR_SIG) {

        my $compressedLength   = unpack("V", substr($buffer, 20, 4));
        my $uncompressedLength = unpack("V", substr($buffer, 24, 4));
        my $filename_length    = unpack("v", substr($buffer, 28, 2));
        my $extra_length       = unpack("v", substr($buffer, 30, 2));
        my $comment_length     = unpack("v", substr($buffer, 32, 2));

        $self->skip($filename_length ) ;

        my $v64 = U64->new( $compressedLength );

        if (U64::full32 $compressedLength ) {
            $self->smartReadExact(\$buffer, $extra_length) ;
            die "xxx $offset $comment_length $filename_length $extra_length" . length($buffer)
                if length($buffer) != $extra_length;
            my $got = $self->get64Extra($buffer, U64::full32 $uncompressedLength);

            # If not Zip64 extra field, assume size is 0xFFFFFFFF
            $v64 = $got if defined $got;
        }
        else {
            $self->skip($extra_length) ;
        }

        $self->skip($comment_length ) ;

        push @CD, $v64 ;
    }

    $self->smartSeek($here, 0, SEEK_SET) ;

    return @CD;
}

sub get64Extra
{
    my $self = shift ;

    my $buffer = shift;
    my $is_uncomp = shift ;

    my $extra = IO::Compress::Zlib::Extra::findID(0x0001, $buffer);

    if (! defined $extra)
    {
        return undef;
    }
    else
    {
        my $u64 = U64::newUnpack_V64(substr($extra,  $is_uncomp ? 8 : 0)) ;
        return $u64;
    }
}

sub offsetFromZip64
{
    my $self = shift ;
    my $here = shift;

    $self->smartSeek($here - 20, 0, SEEK_SET)
        or die "xx $!" ;

    my $buffer;
    my $got = 0;
    $self->smartReadExact(\$buffer, 20)
        or die "xxx $here $got $!" ;

    if ( unpack("V", $buffer) == ZIP64_END_CENTRAL_LOC_HDR_SIG ) {
        my $cd64 = U64::Value_VV64 substr($buffer,  8, 8);

        $self->smartSeek($cd64, 0, SEEK_SET) ;

        $self->smartReadExact(\$buffer, 4)
            or die "xxx" ;

        if ( unpack("V", $buffer) == ZIP64_END_CENTRAL_REC_HDR_SIG ) {

            $self->smartReadExact(\$buffer, 8)
                or die "xxx" ;
            my $size  = U64::Value_VV64($buffer);
            $self->smartReadExact(\$buffer, $size)
                or die "xxx" ;

            my $cd64 =  U64::Value_VV64 substr($buffer,  36, 8);

            return $cd64 ;
        }

        die "zzz";
    }

    die "zzz";
}

use constant Pack_ZIP_END_CENTRAL_HDR_SIG => pack("V", ZIP_END_CENTRAL_HDR_SIG);

sub findCentralDirectoryOffset
{
    my $self = shift ;

    # Most common use-case is where there is no comment, so
    # know exactly where the end of central directory record
    # should be.

    $self->smartSeek(-22, 0, SEEK_END) ;
    my $here = $self->tell();

    my $buffer;
    $self->smartReadExact(\$buffer, 22)
        or die "xxx" ;

    my $zip64 = 0;
    my $centralDirOffset ;
    if ( unpack("V", $buffer) == ZIP_END_CENTRAL_HDR_SIG ) {
        $centralDirOffset = unpack("V", substr($buffer, 16,  4));
    }
    else {
        $self->smartSeek(0, 0, SEEK_END) ;

        my $fileLen = $self->tell();
        my $want = 0 ;

        while(1) {
            $want += 1024;
            my $seekTo = $fileLen - $want;
            if ($seekTo < 0 ) {
                $seekTo = 0;
                $want = $fileLen ;
            }
            $self->smartSeek( $seekTo, 0, SEEK_SET)
                or die "xxx $!" ;
            my $got;
            $self->smartReadExact($buffer, $want)
                or die "xxx " ;
            my $pos = rindex( $buffer, Pack_ZIP_END_CENTRAL_HDR_SIG);

            if ($pos >= 0) {
                #$here = $self->tell();
                $here = $seekTo + $pos ;
                $centralDirOffset = unpack("V", substr($buffer, $pos + 16,  4));
                last ;
            }

            return undef
                if $want == $fileLen;
        }
    }

    $centralDirOffset = $self->offsetFromZip64($here)
        if U64::full32 $centralDirOffset ;

    return $centralDirOffset ;
}

1;

__END__


=head1 NAME

IO::Uncompress::Unzip - Read zip files/buffers

=head1 SYNOPSIS

    use IO::Uncompress::Unzip qw(unzip $UnzipError) ;

    my $status = unzip $input => $output [,OPTS]
        or die "unzip failed: $UnzipError\n";

    my $z = IO::Uncompress::Unzip->new( $input [OPTS] )
        or die "unzip failed: $UnzipError\n";

    $status = $z->read($buffer)
    $status = $z->read($buffer, $length)
    $status = $z->read($buffer, $length, $offset)
    $line = $z->getline()
    $char = $z->getc()
    $char = $z->ungetc()
    $char = $z->opened()

    $status = $z->inflateSync()

    $data = $z->trailingData()
    $status = $z->nextStream()
    $data = $z->getHeaderInfo()
    $z->tell()
    $z->seek($position, $whence)
    $z->binmode()
    $z->fileno()
    $z->eof()
    $z->close()

    $UnzipError ;

    # IO::File mode

    <$z>
    read($z, $buffer);
    read($z, $buffer, $length);
    read($z, $buffer, $length, $offset);
    tell($z)
    seek($z, $position, $whence)
    binmode($z)
    fileno($z)
    eof($z)
    close($z)

=head1 DESCRIPTION

This module provides a Perl interface that allows the reading of
zlib files/buffers.

For writing zip files/buffers, see the companion module IO::Compress::Zip.

The primary purpose of this module is to provide I<streaming> read access to
zip files and buffers.

At present the following compression methods are supported by IO::Uncompress::Unzip

=over 5

=item Store (0)

=item Deflate (8)

=item Bzip2 (12)

To read Bzip2 content, the module C<IO::Uncompress::Bunzip2> must
be installed.

=item Lzma (14)

To read LZMA content, the module C<IO::Uncompress::UnLzma> must
be installed.

=item Xz (95)

To read Xz content, the module C<IO::Uncompress::UnXz> must
be installed.

=item Zstandard (93)

To read Zstandard content, the module C<IO::Uncompress::UnZstd> must
be installed.

=back

=head1 Functional Interface

A top-level function, C<unzip>, is provided to carry out
"one-shot" uncompression between buffers and/or files. For finer
control over the uncompression process, see the L</"OO Interface">
section.

    use IO::Uncompress::Unzip qw(unzip $UnzipError) ;

    unzip $input_filename_or_reference => $output_filename_or_reference [,OPTS]
        or die "unzip failed: $UnzipError\n";

The functional interface needs Perl5.005 or better.

=head2 unzip $input_filename_or_reference => $output_filename_or_reference [, OPTS]

C<unzip> expects at least two parameters,
C<$input_filename_or_reference> and C<$output_filename_or_reference>
and zero or more optional parameters (see L</Optional Parameters>)

=head3 The C<$input_filename_or_reference> parameter

The parameter, C<$input_filename_or_reference>, is used to define the
source of the compressed data.

It can take one of the following forms:

=over 5

=item A filename

If the C<$input_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename. This file will be opened for reading and the
input data will be read from it.

=item A filehandle

If the C<$input_filename_or_reference> parameter is a filehandle, the input
data will be read from it.  The string '-' can be used as an alias for
standard input.

=item A scalar reference

If C<$input_filename_or_reference> is a scalar reference, the input data
will be read from C<$$input_filename_or_reference>.

=item An array reference

If C<$input_filename_or_reference> is an array reference, each element in
the array must be a filename.

The input data will be read from each file in turn.

The complete array will be walked to ensure that it only
contains valid filenames before any data is uncompressed.

=item An Input FileGlob string

If C<$input_filename_or_reference> is a string that is delimited by the
characters "<" and ">" C<unzip> will assume that it is an
I<input fileglob string>. The input is the list of files that match the
fileglob.

See L<File::GlobMapper|File::GlobMapper> for more details.

=back

If the C<$input_filename_or_reference> parameter is any other type,
C<undef> will be returned.

=head3 The C<$output_filename_or_reference> parameter

The parameter C<$output_filename_or_reference> is used to control the
destination of the uncompressed data. This parameter can take one of
these forms.

=over 5

=item A filename

If the C<$output_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename.  This file will be opened for writing and the
uncompressed data will be written to it.

=item A filehandle

If the C<$output_filename_or_reference> parameter is a filehandle, the
uncompressed data will be written to it.  The string '-' can be used as
an alias for standard output.

=item A scalar reference

If C<$output_filename_or_reference> is a scalar reference, the
uncompressed data will be stored in C<$$output_filename_or_reference>.

=item An Array Reference

If C<$output_filename_or_reference> is an array reference,
the uncompressed data will be pushed onto the array.

=item An Output FileGlob

If C<$output_filename_or_reference> is a string that is delimited by the
characters "<" and ">" C<unzip> will assume that it is an
I<output fileglob string>. The output is the list of files that match the
fileglob.

When C<$output_filename_or_reference> is an fileglob string,
C<$input_filename_or_reference> must also be a fileglob string. Anything
else is an error.

See L<File::GlobMapper|File::GlobMapper> for more details.

=back

If the C<$output_filename_or_reference> parameter is any other type,
C<undef> will be returned.

=head2 Notes

When C<$input_filename_or_reference> maps to multiple compressed
files/buffers and C<$output_filename_or_reference> is
a single file/buffer, after uncompression C<$output_filename_or_reference> will contain a
concatenation of all the uncompressed data from each of the input
files/buffers.

=head2 Optional Parameters

The optional parameters for the one-shot function C<unzip>
are (for the most part) identical to those used with the OO interface defined in the
L</"Constructor Options"> section. The exceptions are listed below

=over 5

=item C<< AutoClose => 0|1 >>

This option applies to any input or output data streams to
C<unzip> that are filehandles.

If C<AutoClose> is specified, and the value is true, it will result in all
input and/or output filehandles being closed once C<unzip> has
completed.

This parameter defaults to 0.

=item C<< BinModeOut => 0|1 >>

This option is now a no-op. All files will be written  in binmode.

=item C<< Append => 0|1 >>

The behaviour of this option is dependent on the type of output data
stream.

=over 5

=item * A Buffer

If C<Append> is enabled, all uncompressed data will be append to the end of
the output buffer. Otherwise the output buffer will be cleared before any
uncompressed data is written to it.

=item * A Filename

If C<Append> is enabled, the file will be opened in append mode. Otherwise
the contents of the file, if any, will be truncated before any uncompressed
data is written to it.

=item * A Filehandle

If C<Append> is enabled, the filehandle will be positioned to the end of
the file via a call to C<seek> before any uncompressed data is
written to it.  Otherwise the file pointer will not be moved.

=back

When C<Append> is specified, and set to true, it will I<append> all uncompressed
data to the output data stream.

So when the output is a filehandle it will carry out a seek to the eof
before writing any uncompressed data. If the output is a filename, it will be opened for
appending. If the output is a buffer, all uncompressed data will be
appended to the existing buffer.

Conversely when C<Append> is not specified, or it is present and is set to
false, it will operate as follows.

When the output is a filename, it will truncate the contents of the file
before writing any uncompressed data. If the output is a filehandle
its position will not be changed. If the output is a buffer, it will be
wiped before any uncompressed data is output.

Defaults to 0.

=item C<< MultiStream => 0|1 >>

If the input file/buffer contains multiple compressed data streams, this
option will uncompress the whole lot as a single data stream.

Defaults to 0.

=item C<< TrailingData => $scalar >>

Returns the data, if any, that is present immediately after the compressed
data stream once uncompression is complete.

This option can be used when there is useful information immediately
following the compressed data stream, and you don't know the length of the
compressed data stream.

If the input is a buffer, C<trailingData> will return everything from the
end of the compressed data stream to the end of the buffer.

If the input is a filehandle, C<trailingData> will return the data that is
left in the filehandle input buffer once the end of the compressed data
stream has been reached. You can then use the filehandle to read the rest
of the input file.

Don't bother using C<trailingData> if the input is a filename.

If you know the length of the compressed data stream before you start
uncompressing, you can avoid having to use C<trailingData> by setting the
C<InputLength> option.

=back

=head2 Examples

Say you have a zip file, C<file1.zip>, that only contains a
single member, you can read it and write the uncompressed data to the
file C<file1.txt> like this.

    use strict ;
    use warnings ;
    use IO::Uncompress::Unzip qw(unzip $UnzipError) ;

    my $input = "file1.zip";
    my $output = "file1.txt";
    unzip $input => $output
        or die "unzip failed: $UnzipError\n";

If you have a zip file that contains multiple members and want to read a
specific member from the file, say C<"data1">, use the C<Name> option

    use strict ;
    use warnings ;
    use IO::Uncompress::Unzip qw(unzip $UnzipError) ;

    my $input = "file1.zip";
    my $output = "file1.txt";
    unzip $input => $output, Name => "data1"
        or die "unzip failed: $UnzipError\n";

Alternatively, if you want to read the  C<"data1"> member into memory, use
a scalar reference for the C<output> parameter.

    use strict ;
    use warnings ;
    use IO::Uncompress::Unzip qw(unzip $UnzipError) ;

    my $input = "file1.zip";
    my $output ;
    unzip $input => \$output, Name => "data1"
        or die "unzip failed: $UnzipError\n";
    # $output now contains the uncompressed data

To read from an existing Perl filehandle, C<$input>, and write the
uncompressed data to a buffer, C<$buffer>.

    use strict ;
    use warnings ;
    use IO::Uncompress::Unzip qw(unzip $UnzipError) ;
    use IO::File ;

    my $input = IO::File->new( "<file1.zip" )
        or die "Cannot open 'file1.zip': $!\n" ;
    my $buffer ;
    unzip $input => \$buffer
        or die "unzip failed: $UnzipError\n";

=head1 OO Interface

=head2 Constructor

The format of the constructor for IO::Uncompress::Unzip is shown below

    my $z = IO::Uncompress::Unzip->new( $input [OPTS] )
        or die "IO::Uncompress::Unzip failed: $UnzipError\n";

Returns an C<IO::Uncompress::Unzip> object on success and undef on failure.
The variable C<$UnzipError> will contain an error message on failure.

If you are running Perl 5.005 or better the object, C<$z>, returned from
IO::Uncompress::Unzip can be used exactly like an L<IO::File|IO::File> filehandle.
This means that all normal input file operations can be carried out with
C<$z>.  For example, to read a line from a compressed file/buffer you can
use either of these forms

    $line = $z->getline();
    $line = <$z>;

The mandatory parameter C<$input> is used to determine the source of the
compressed data. This parameter can take one of three forms.

=over 5

=item A filename

If the C<$input> parameter is a scalar, it is assumed to be a filename. This
file will be opened for reading and the compressed data will be read from it.

=item A filehandle

If the C<$input> parameter is a filehandle, the compressed data will be
read from it.
The string '-' can be used as an alias for standard input.

=item A scalar reference

If C<$input> is a scalar reference, the compressed data will be read from
C<$$input>.

=back

=head2 Constructor Options

The option names defined below are case insensitive and can be optionally
prefixed by a '-'.  So all of the following are valid

    -AutoClose
    -autoclose
    AUTOCLOSE
    autoclose

OPTS is a combination of the following options:

=over 5

=item C<< Name => "membername" >>

Open "membername" from the zip file for reading.

=item C<< Efs => 0| 1 >>

When this option is set to true AND the zip archive being read has
the "Language Encoding Flag" (EFS) set, the member name is assumed to be encoded in UTF-8.

If the member name in the zip archive is not valid UTF-8 when this optionn is true,
the script will die with an error message.

Note that this option only works with Perl 5.8.4 or better.

This option defaults to B<false>.

=item C<< AutoClose => 0|1 >>

This option is only valid when the C<$input> parameter is a filehandle. If
specified, and the value is true, it will result in the file being closed once
either the C<close> method is called or the IO::Uncompress::Unzip object is
destroyed.

This parameter defaults to 0.

=item C<< MultiStream => 0|1 >>

Treats the complete zip file/buffer as a single compressed data
stream. When reading in multi-stream mode each member of the zip
file/buffer will be uncompressed in turn until the end of the file/buffer
is encountered.

This parameter defaults to 0.

=item C<< Prime => $string >>

This option will uncompress the contents of C<$string> before processing the
input file/buffer.

This option can be useful when the compressed data is embedded in another
file/data structure and it is not possible to work out where the compressed
data begins without having to read the first few bytes. If this is the
case, the uncompression can be I<primed> with these bytes using this
option.

=item C<< Transparent => 0|1 >>

If this option is set and the input file/buffer is not compressed data,
the module will allow reading of it anyway.

In addition, if the input file/buffer does contain compressed data and
there is non-compressed data immediately following it, setting this option
will make this module treat the whole file/buffer as a single data stream.

This option defaults to 1.

=item C<< BlockSize => $num >>

When reading the compressed input data, IO::Uncompress::Unzip will read it in
blocks of C<$num> bytes.

This option defaults to 4096.

=item C<< InputLength => $size >>

When present this option will limit the number of compressed bytes read
from the input file/buffer to C<$size>. This option can be used in the
situation where there is useful data directly after the compressed data
stream and you know beforehand the exact length of the compressed data
stream.

This option is mostly used when reading from a filehandle, in which case
the file pointer will be left pointing to the first byte directly after the
compressed data stream.

This option defaults to off.

=item C<< Append => 0|1 >>

This option controls what the C<read> method does with uncompressed data.

If set to 1, all uncompressed data will be appended to the output parameter
of the C<read> method.

If set to 0, the contents of the output parameter of the C<read> method
will be overwritten by the uncompressed data.

Defaults to 0.

=item C<< Strict => 0|1 >>

This option controls whether the extra checks defined below are used when
carrying out the decompression. When Strict is on, the extra tests are
carried out, when Strict is off they are not.

The default for this option is off.

=back

=head2 Examples

TODO

=head1 Methods

=head2 read

Usage is

    $status = $z->read($buffer)

Reads a block of compressed data (the size of the compressed block is
determined by the C<Buffer> option in the constructor), uncompresses it and
writes any uncompressed data into C<$buffer>. If the C<Append> parameter is
set in the constructor, the uncompressed data will be appended to the
C<$buffer> parameter. Otherwise C<$buffer> will be overwritten.

Returns the number of uncompressed bytes written to C<$buffer>, zero if eof
or a negative number on error.

=head2 read

Usage is

    $status = $z->read($buffer, $length)
    $status = $z->read($buffer, $length, $offset)

    $status = read($z, $buffer, $length)
    $status = read($z, $buffer, $length, $offset)

Attempt to read C<$length> bytes of uncompressed data into C<$buffer>.

The main difference between this form of the C<read> method and the
previous one, is that this one will attempt to return I<exactly> C<$length>
bytes. The only circumstances that this function will not is if end-of-file
or an IO error is encountered.

Returns the number of uncompressed bytes written to C<$buffer>, zero if eof
or a negative number on error.

=head2 getline

Usage is

    $line = $z->getline()
    $line = <$z>

Reads a single line.

This method fully supports the use of the variable C<$/> (or
C<$INPUT_RECORD_SEPARATOR> or C<$RS> when C<English> is in use) to
determine what constitutes an end of line. Paragraph mode, record mode and
file slurp mode are all supported.

=head2 getc

Usage is

    $char = $z->getc()

Read a single character.

=head2 ungetc

Usage is

    $char = $z->ungetc($string)

=head2 inflateSync

Usage is

    $status = $z->inflateSync()

TODO

=head2 getHeaderInfo

Usage is

    $hdr  = $z->getHeaderInfo();
    @hdrs = $z->getHeaderInfo();

This method returns either a hash reference (in scalar context) or a list
or hash references (in array context) that contains information about each
of the header fields in the compressed data stream(s).

=head2 tell

Usage is

    $z->tell()
    tell $z

Returns the uncompressed file offset.

=head2 eof

Usage is

    $z->eof();
    eof($z);

Returns true if the end of the compressed input stream has been reached.

=head2 seek

    $z->seek($position, $whence);
    seek($z, $position, $whence);

Provides a sub-set of the C<seek> functionality, with the restriction
that it is only legal to seek forward in the input file/buffer.
It is a fatal error to attempt to seek backward.

Note that the implementation of C<seek> in this module does not provide
true random access to a compressed file/buffer. It  works by uncompressing
data from the current offset in the file/buffer until it reaches the
uncompressed offset specified in the parameters to C<seek>. For very small
files this may be acceptable behaviour. For large files it may cause an
unacceptable delay.

The C<$whence> parameter takes one the usual values, namely SEEK_SET,
SEEK_CUR or SEEK_END.

Returns 1 on success, 0 on failure.

=head2 binmode

Usage is

    $z->binmode
    binmode $z ;

This is a noop provided for completeness.

=head2 opened

    $z->opened()

Returns true if the object currently refers to a opened file/buffer.

=head2 autoflush

    my $prev = $z->autoflush()
    my $prev = $z->autoflush(EXPR)

If the C<$z> object is associated with a file or a filehandle, this method
returns the current autoflush setting for the underlying filehandle. If
C<EXPR> is present, and is non-zero, it will enable flushing after every
write/print operation.

If C<$z> is associated with a buffer, this method has no effect and always
returns C<undef>.

B<Note> that the special variable C<$|> B<cannot> be used to set or
retrieve the autoflush setting.

=head2 input_line_number

    $z->input_line_number()
    $z->input_line_number(EXPR)

Returns the current uncompressed line number. If C<EXPR> is present it has
the effect of setting the line number. Note that setting the line number
does not change the current position within the file/buffer being read.

The contents of C<$/> are used to determine what constitutes a line
terminator.

=head2 fileno

    $z->fileno()
    fileno($z)

If the C<$z> object is associated with a file or a filehandle, C<fileno>
will return the underlying file descriptor. Once the C<close> method is
called C<fileno> will return C<undef>.

If the C<$z> object is associated with a buffer, this method will return
C<undef>.

=head2 close

    $z->close() ;
    close $z ;

Closes the output file/buffer.

For most versions of Perl this method will be automatically invoked if
the IO::Uncompress::Unzip object is destroyed (either explicitly or by the
variable with the reference to the object going out of scope). The
exceptions are Perl versions 5.005 through 5.00504 and 5.8.0. In
these cases, the C<close> method will be called automatically, but
not until global destruction of all live objects when the program is
terminating.

Therefore, if you want your scripts to be able to run on all versions
of Perl, you should call C<close> explicitly and not rely on automatic
closing.

Returns true on success, otherwise 0.

If the C<AutoClose> option has been enabled when the IO::Uncompress::Unzip
object was created, and the object is associated with a file, the
underlying file will also be closed.

=head2 nextStream

Usage is

    my $status = $z->nextStream();

Skips to the next compressed data stream in the input file/buffer. If a new
compressed data stream is found, the eof marker will be cleared and C<$.>
will be reset to 0.

If trailing data is present immediately after the zip archive and the
C<Transparent> option is enabled, this method will consider that trailing
data to be another member of the zip archive.

Returns 1 if a new stream was found, 0 if none was found, and -1 if an
error was encountered.

=head2 trailingData

Usage is

    my $data = $z->trailingData();

Returns the data, if any, that is present immediately after the compressed
data stream once uncompression is complete. It only makes sense to call
this method once the end of the compressed data stream has been
encountered.

This option can be used when there is useful information immediately
following the compressed data stream, and you don't know the length of the
compressed data stream.

If the input is a buffer, C<trailingData> will return everything from the
end of the compressed data stream to the end of the buffer.

If the input is a filehandle, C<trailingData> will return the data that is
left in the filehandle input buffer once the end of the compressed data
stream has been reached. You can then use the filehandle to read the rest
of the input file.

Don't bother using C<trailingData> if the input is a filename.

If you know the length of the compressed data stream before you start
uncompressing, you can avoid having to use C<trailingData> by setting the
C<InputLength> option in the constructor.

=head1 Importing

No symbolic constants are required by IO::Uncompress::Unzip at present.

=over 5

=item :all

Imports C<unzip> and C<$UnzipError>.
Same as doing this

    use IO::Uncompress::Unzip qw(unzip $UnzipError) ;

=back

=head1 EXAMPLES

=head2 Working with Net::FTP

See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP">

=head2 Walking through a zip file

The code below can be used to traverse a zip file, one compressed data
stream at a time.

    use IO::Uncompress::Unzip qw($UnzipError);

    my $zipfile = "somefile.zip";
    my $u = IO::Uncompress::Unzip->new( $zipfile )
        or die "Cannot open $zipfile: $UnzipError";

    my $status;
    for ($status = 1; $status > 0; $status = $u->nextStream())
    {

        my $name = $u->getHeaderInfo()->{Name};
        warn "Processing member $name\n" ;

        my $buff;
        while (($status = $u->read($buff)) > 0) {
            # Do something here
        }

        last if $status < 0;
    }

    die "Error processing $zipfile: $!\n"
        if $status < 0 ;

Each individual compressed data stream is read until the logical
end-of-file is reached. Then C<nextStream> is called. This will skip to the
start of the next compressed data stream and clear the end-of-file flag.

It is also worth noting that C<nextStream> can be called at any time -- you
don't have to wait until you have exhausted a compressed data stream before
skipping to the next one.

=head2 Unzipping a complete zip file to disk

Daniel S. Sterling has written a script that uses C<IO::Uncompress::UnZip>
to read a zip file and unzip its contents to disk.

The script is available from L<https://gist.github.com/eqhmcow/5389877>

=head1 SUPPORT

General feedback/questions/bug reports should be sent to
L<https://github.com/pmqs/IO-Compress/issues> (preferred) or
L<https://rt.cpan.org/Public/Dist/Display.html?Name=IO-Compress>.

=head1 SEE ALSO

L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzip>, L<IO::Uncompress::UnLzip>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Compress::Zstd>, L<IO::Uncompress::UnZstd>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>

L<IO::Compress::FAQ|IO::Compress::FAQ>

L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>,
L<Archive::Tar|Archive::Tar>,
L<IO::Zlib|IO::Zlib>

For RFC 1950, 1951 and 1952 see
L<http://www.faqs.org/rfcs/rfc1950.html>,
L<http://www.faqs.org/rfcs/rfc1951.html> and
L<http://www.faqs.org/rfcs/rfc1952.html>

The I<zlib> compression library was written by Jean-loup Gailly
C<gzip@prep.ai.mit.edu> and Mark Adler C<madler@alumni.caltech.edu>.

The primary site for the I<zlib> compression library is
L<http://www.zlib.org>.

The primary site for gzip is L<http://www.gzip.org>.

=head1 AUTHOR

This module was written by Paul Marquess, C<pmqs@cpan.org>.

=head1 MODIFICATION HISTORY

See the Changes file.

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2005-2021 Paul Marquess. All rights reserved.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       Uncompress/AnyUncompress.pm                                                                         0000644                 00000074531 00000000000 0012021 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       package IO::Uncompress::AnyUncompress ;

use strict;
use warnings;
use bytes;

use IO::Compress::Base::Common 2.101 ();

use IO::Uncompress::Base 2.101 ;


require Exporter ;

our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $AnyUncompressError);

$VERSION = '2.102';
$AnyUncompressError = '';

@ISA = qw(IO::Uncompress::Base Exporter);
@EXPORT_OK = qw( $AnyUncompressError anyuncompress ) ;
%EXPORT_TAGS = %IO::Uncompress::Base::DEFLATE_CONSTANTS if keys %IO::Uncompress::Base::DEFLATE_CONSTANTS;
push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
Exporter::export_ok_tags('all');

# TODO - allow the user to pick a set of the three formats to allow
#        or just assume want to auto-detect any of the three formats.

BEGIN
{
   local @INC = @INC;
   pop @INC if $INC[-1] eq '.';

   # Don't trigger any __DIE__ Hooks.
   local $SIG{__DIE__};

   eval ' use IO::Uncompress::Adapter::Inflate 2.101 ;';
   eval ' use IO::Uncompress::Adapter::Bunzip2 2.101 ;';
   eval ' use IO::Uncompress::Adapter::LZO 2.101 ;';
   eval ' use IO::Uncompress::Adapter::Lzf 2.101 ;';
   eval ' use IO::Uncompress::Adapter::UnLzma 2.101 ;';
   eval ' use IO::Uncompress::Adapter::UnXz 2.101 ;';
   eval ' use IO::Uncompress::Adapter::UnZstd 2.101 ;';
   eval ' use IO::Uncompress::Adapter::UnLzip 2.101 ;';

   eval ' use IO::Uncompress::Bunzip2 2.101 ;';
   eval ' use IO::Uncompress::UnLzop 2.101 ;';
   eval ' use IO::Uncompress::Gunzip 2.101 ;';
   eval ' use IO::Uncompress::Inflate 2.101 ;';
   eval ' use IO::Uncompress::RawInflate 2.101 ;';
   eval ' use IO::Uncompress::Unzip 2.101 ;';
   eval ' use IO::Uncompress::UnLzf 2.101 ;';
   eval ' use IO::Uncompress::UnLzma 2.101 ;';
   eval ' use IO::Uncompress::UnXz 2.101 ;';
   eval ' use IO::Uncompress::UnZstd 2.101 ;';
   eval ' use IO::Uncompress::UnLzip 2.101 ;';

}

sub new
{
    my $class = shift ;
    my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$AnyUncompressError);
    $obj->_create(undef, 0, @_);
}

sub anyuncompress
{
    my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$AnyUncompressError);
    return $obj->_inf(@_) ;
}

sub getExtraParams
{
    return ( 'rawinflate' => [IO::Compress::Base::Common::Parse_boolean,  0] ,
             'unlzma'     => [IO::Compress::Base::Common::Parse_boolean,  0] ) ;
}

sub ckParams
{
    my $self = shift ;
    my $got = shift ;

    # any always needs both crc32 and adler32
    $got->setValue('crc32' => 1);
    $got->setValue('adler32' => 1);

    return 1;
}

sub mkUncomp
{
    my $self = shift ;
    my $got = shift ;

    my $magic ;

    # try zlib first
    if (defined $IO::Uncompress::RawInflate::VERSION )
    {
        my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::Inflate::mkUncompObject();

        return $self->saveErrorString(undef, $errstr, $errno)
            if ! defined $obj;

        *$self->{Uncomp} = $obj;

        my @possible = qw( Inflate Gunzip Unzip );
        unshift @possible, 'RawInflate'
            if $got->getValue('rawinflate');

        $magic = $self->ckMagic( @possible );

        if ($magic) {
            *$self->{Info} = $self->readHeader($magic)
                or return undef ;

            return 1;
        }
     }

    if (defined $IO::Uncompress::UnLzma::VERSION && $got->getValue('unlzma'))
    {
        my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::UnLzma::mkUncompObject();

        return $self->saveErrorString(undef, $errstr, $errno)
            if ! defined $obj;

        *$self->{Uncomp} = $obj;

        my @possible = qw( UnLzma );
        #unshift @possible, 'RawInflate'
        #    if $got->getValue('rawinflate');

        if ( *$self->{Info} = $self->ckMagic( @possible ))
        {
            return 1;
        }
     }

     if (defined $IO::Uncompress::UnXz::VERSION and
         $magic = $self->ckMagic('UnXz')) {
        *$self->{Info} = $self->readHeader($magic)
            or return undef ;

        my ($obj, $errstr, $errno) =
            IO::Uncompress::Adapter::UnXz::mkUncompObject();

        return $self->saveErrorString(undef, $errstr, $errno)
            if ! defined $obj;

        *$self->{Uncomp} = $obj;

         return 1;
     }

     if (defined $IO::Uncompress::Bunzip2::VERSION and
         $magic = $self->ckMagic('Bunzip2')) {
        *$self->{Info} = $self->readHeader($magic)
            or return undef ;

        my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::Bunzip2::mkUncompObject();

        return $self->saveErrorString(undef, $errstr, $errno)
            if ! defined $obj;

        *$self->{Uncomp} = $obj;

         return 1;
     }

     if (defined $IO::Uncompress::UnLzop::VERSION and
            $magic = $self->ckMagic('UnLzop')) {

        *$self->{Info} = $self->readHeader($magic)
            or return undef ;

        my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::LZO::mkUncompObject();

        return $self->saveErrorString(undef, $errstr, $errno)
            if ! defined $obj;

        *$self->{Uncomp} = $obj;

         return 1;
     }

     if (defined $IO::Uncompress::UnLzf::VERSION and
            $magic = $self->ckMagic('UnLzf')) {

        *$self->{Info} = $self->readHeader($magic)
            or return undef ;

        my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::Lzf::mkUncompObject();

        return $self->saveErrorString(undef, $errstr, $errno)
            if ! defined $obj;

        *$self->{Uncomp} = $obj;

         return 1;
     }

     if (defined $IO::Uncompress::UnZstd::VERSION and
            $magic = $self->ckMagic('UnZstd')) {

        *$self->{Info} = $self->readHeader($magic)
            or return undef ;

        my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::UnZstd::mkUncompObject();

        return $self->saveErrorString(undef, $errstr, $errno)
            if ! defined $obj;

        *$self->{Uncomp} = $obj;

         return 1;
     }


     if (defined $IO::Uncompress::UnLzip::VERSION and
            $magic = $self->ckMagic('UnLzip')) {

        *$self->{Info} = $self->readHeader($magic)
            or return undef ;

        my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::UnLzip::mkUncompObject(*$self->{Info}{DictSize});

        return $self->saveErrorString(undef, $errstr, $errno)
            if ! defined $obj;

        *$self->{Uncomp} = $obj;

         return 1;
     }

     return 0 ;
}



sub ckMagic
{
    my $self = shift;
    my @names = @_ ;

    my $keep = ref $self ;
    for my $class ( map { "IO::Uncompress::$_" } @names)
    {
        bless $self => $class;
        my $magic = $self->ckMagic();

        if ($magic)
        {
            #bless $self => $class;
            return $magic ;
        }

        $self->pushBack(*$self->{HeaderPending})  ;
        *$self->{HeaderPending} = ''  ;
    }

    bless $self => $keep;
    return undef;
}

1 ;

__END__


=head1 NAME

IO::Uncompress::AnyUncompress - Uncompress gzip, zip, bzip2, zstd, xz, lzma, lzip, lzf or lzop file/buffer

=head1 SYNOPSIS

    use IO::Uncompress::AnyUncompress qw(anyuncompress $AnyUncompressError) ;

    my $status = anyuncompress $input => $output [,OPTS]
        or die "anyuncompress failed: $AnyUncompressError\n";

    my $z = IO::Uncompress::AnyUncompress->new( $input [OPTS] )
        or die "anyuncompress failed: $AnyUncompressError\n";

    $status = $z->read($buffer)
    $status = $z->read($buffer, $length)
    $status = $z->read($buffer, $length, $offset)
    $line = $z->getline()
    $char = $z->getc()
    $char = $z->ungetc()
    $char = $z->opened()

    $data = $z->trailingData()
    $status = $z->nextStream()
    $data = $z->getHeaderInfo()
    $z->tell()
    $z->seek($position, $whence)
    $z->binmode()
    $z->fileno()
    $z->eof()
    $z->close()

    $AnyUncompressError ;

    # IO::File mode

    <$z>
    read($z, $buffer);
    read($z, $buffer, $length);
    read($z, $buffer, $length, $offset);
    tell($z)
    seek($z, $position, $whence)
    binmode($z)
    fileno($z)
    eof($z)
    close($z)

=head1 DESCRIPTION

This module provides a Perl interface that allows the reading of
files/buffers that have been compressed with a variety of compression
libraries.

The formats supported are:

=over 5

=item RFC 1950

=item RFC 1951 (optionally)

=item gzip (RFC 1952)

=item zip

=item zstd (Zstandard)

=item bzip2

=item lzop

=item lzf

=item lzma

=item lzip

=item xz

=back

The module will auto-detect which, if any, of the supported
compression formats is being used.

=head1 Functional Interface

A top-level function, C<anyuncompress>, is provided to carry out
"one-shot" uncompression between buffers and/or files. For finer
control over the uncompression process, see the L</"OO Interface">
section.

    use IO::Uncompress::AnyUncompress qw(anyuncompress $AnyUncompressError) ;

    anyuncompress $input_filename_or_reference => $output_filename_or_reference [,OPTS]
        or die "anyuncompress failed: $AnyUncompressError\n";

The functional interface needs Perl5.005 or better.

=head2 anyuncompress $input_filename_or_reference => $output_filename_or_reference [, OPTS]

C<anyuncompress> expects at least two parameters,
C<$input_filename_or_reference> and C<$output_filename_or_reference>
and zero or more optional parameters (see L</Optional Parameters>)

=head3 The C<$input_filename_or_reference> parameter

The parameter, C<$input_filename_or_reference>, is used to define the
source of the compressed data.

It can take one of the following forms:

=over 5

=item A filename

If the C<$input_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename. This file will be opened for reading and the
input data will be read from it.

=item A filehandle

If the C<$input_filename_or_reference> parameter is a filehandle, the input
data will be read from it.  The string '-' can be used as an alias for
standard input.

=item A scalar reference

If C<$input_filename_or_reference> is a scalar reference, the input data
will be read from C<$$input_filename_or_reference>.

=item An array reference

If C<$input_filename_or_reference> is an array reference, each element in
the array must be a filename.

The input data will be read from each file in turn.

The complete array will be walked to ensure that it only
contains valid filenames before any data is uncompressed.

=item An Input FileGlob string

If C<$input_filename_or_reference> is a string that is delimited by the
characters "<" and ">" C<anyuncompress> will assume that it is an
I<input fileglob string>. The input is the list of files that match the
fileglob.

See L<File::GlobMapper|File::GlobMapper> for more details.

=back

If the C<$input_filename_or_reference> parameter is any other type,
C<undef> will be returned.

=head3 The C<$output_filename_or_reference> parameter

The parameter C<$output_filename_or_reference> is used to control the
destination of the uncompressed data. This parameter can take one of
these forms.

=over 5

=item A filename

If the C<$output_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename.  This file will be opened for writing and the
uncompressed data will be written to it.

=item A filehandle

If the C<$output_filename_or_reference> parameter is a filehandle, the
uncompressed data will be written to it.  The string '-' can be used as
an alias for standard output.

=item A scalar reference

If C<$output_filename_or_reference> is a scalar reference, the
uncompressed data will be stored in C<$$output_filename_or_reference>.

=item An Array Reference

If C<$output_filename_or_reference> is an array reference,
the uncompressed data will be pushed onto the array.

=item An Output FileGlob

If C<$output_filename_or_reference> is a string that is delimited by the
characters "<" and ">" C<anyuncompress> will assume that it is an
I<output fileglob string>. The output is the list of files that match the
fileglob.

When C<$output_filename_or_reference> is an fileglob string,
C<$input_filename_or_reference> must also be a fileglob string. Anything
else is an error.

See L<File::GlobMapper|File::GlobMapper> for more details.

=back

If the C<$output_filename_or_reference> parameter is any other type,
C<undef> will be returned.

=head2 Notes

When C<$input_filename_or_reference> maps to multiple compressed
files/buffers and C<$output_filename_or_reference> is
a single file/buffer, after uncompression C<$output_filename_or_reference> will contain a
concatenation of all the uncompressed data from each of the input
files/buffers.

=head2 Optional Parameters

The optional parameters for the one-shot function C<anyuncompress>
are (for the most part) identical to those used with the OO interface defined in the
L</"Constructor Options"> section. The exceptions are listed below

=over 5

=item C<< AutoClose => 0|1 >>

This option applies to any input or output data streams to
C<anyuncompress> that are filehandles.

If C<AutoClose> is specified, and the value is true, it will result in all
input and/or output filehandles being closed once C<anyuncompress> has
completed.

This parameter defaults to 0.

=item C<< BinModeOut => 0|1 >>

This option is now a no-op. All files will be written  in binmode.

=item C<< Append => 0|1 >>

The behaviour of this option is dependent on the type of output data
stream.

=over 5

=item * A Buffer

If C<Append> is enabled, all uncompressed data will be append to the end of
the output buffer. Otherwise the output buffer will be cleared before any
uncompressed data is written to it.

=item * A Filename

If C<Append> is enabled, the file will be opened in append mode. Otherwise
the contents of the file, if any, will be truncated before any uncompressed
data is written to it.

=item * A Filehandle

If C<Append> is enabled, the filehandle will be positioned to the end of
the file via a call to C<seek> before any uncompressed data is
written to it.  Otherwise the file pointer will not be moved.

=back

When C<Append> is specified, and set to true, it will I<append> all uncompressed
data to the output data stream.

So when the output is a filehandle it will carry out a seek to the eof
before writing any uncompressed data. If the output is a filename, it will be opened for
appending. If the output is a buffer, all uncompressed data will be
appended to the existing buffer.

Conversely when C<Append> is not specified, or it is present and is set to
false, it will operate as follows.

When the output is a filename, it will truncate the contents of the file
before writing any uncompressed data. If the output is a filehandle
its position will not be changed. If the output is a buffer, it will be
wiped before any uncompressed data is output.

Defaults to 0.

=item C<< MultiStream => 0|1 >>

If the input file/buffer contains multiple compressed data streams, this
option will uncompress the whole lot as a single data stream.

Defaults to 0.

=item C<< TrailingData => $scalar >>

Returns the data, if any, that is present immediately after the compressed
data stream once uncompression is complete.

This option can be used when there is useful information immediately
following the compressed data stream, and you don't know the length of the
compressed data stream.

If the input is a buffer, C<trailingData> will return everything from the
end of the compressed data stream to the end of the buffer.

If the input is a filehandle, C<trailingData> will return the data that is
left in the filehandle input buffer once the end of the compressed data
stream has been reached. You can then use the filehandle to read the rest
of the input file.

Don't bother using C<trailingData> if the input is a filename.

If you know the length of the compressed data stream before you start
uncompressing, you can avoid having to use C<trailingData> by setting the
C<InputLength> option.

=back

=head2 Examples

To read the contents of the file C<file1.txt.Compressed> and write the
uncompressed data to the file C<file1.txt>.

    use strict ;
    use warnings ;
    use IO::Uncompress::AnyUncompress qw(anyuncompress $AnyUncompressError) ;

    my $input = "file1.txt.Compressed";
    my $output = "file1.txt";
    anyuncompress $input => $output
        or die "anyuncompress failed: $AnyUncompressError\n";

To read from an existing Perl filehandle, C<$input>, and write the
uncompressed data to a buffer, C<$buffer>.

    use strict ;
    use warnings ;
    use IO::Uncompress::AnyUncompress qw(anyuncompress $AnyUncompressError) ;
    use IO::File ;

    my $input = IO::File->new( "<file1.txt.Compressed" )
        or die "Cannot open 'file1.txt.Compressed': $!\n" ;
    my $buffer ;
    anyuncompress $input => \$buffer
        or die "anyuncompress failed: $AnyUncompressError\n";

To uncompress all files in the directory "/my/home" that match "*.txt.Compressed" and store the compressed data in the same directory

    use strict ;
    use warnings ;
    use IO::Uncompress::AnyUncompress qw(anyuncompress $AnyUncompressError) ;

    anyuncompress '</my/home/*.txt.Compressed>' => '</my/home/#1.txt>'
        or die "anyuncompress failed: $AnyUncompressError\n";

and if you want to compress each file one at a time, this will do the trick

    use strict ;
    use warnings ;
    use IO::Uncompress::AnyUncompress qw(anyuncompress $AnyUncompressError) ;

    for my $input ( glob "/my/home/*.txt.Compressed" )
    {
        my $output = $input;
        $output =~ s/.Compressed// ;
        anyuncompress $input => $output
            or die "Error compressing '$input': $AnyUncompressError\n";
    }

=head1 OO Interface

=head2 Constructor

The format of the constructor for IO::Uncompress::AnyUncompress is shown below

    my $z = IO::Uncompress::AnyUncompress->new( $input [OPTS] )
        or die "IO::Uncompress::AnyUncompress failed: $AnyUncompressError\n";

Returns an C<IO::Uncompress::AnyUncompress> object on success and undef on failure.
The variable C<$AnyUncompressError> will contain an error message on failure.

If you are running Perl 5.005 or better the object, C<$z>, returned from
IO::Uncompress::AnyUncompress can be used exactly like an L<IO::File|IO::File> filehandle.
This means that all normal input file operations can be carried out with
C<$z>.  For example, to read a line from a compressed file/buffer you can
use either of these forms

    $line = $z->getline();
    $line = <$z>;

The mandatory parameter C<$input> is used to determine the source of the
compressed data. This parameter can take one of three forms.

=over 5

=item A filename

If the C<$input> parameter is a scalar, it is assumed to be a filename. This
file will be opened for reading and the compressed data will be read from it.

=item A filehandle

If the C<$input> parameter is a filehandle, the compressed data will be
read from it.
The string '-' can be used as an alias for standard input.

=item A scalar reference

If C<$input> is a scalar reference, the compressed data will be read from
C<$$input>.

=back

=head2 Constructor Options

The option names defined below are case insensitive and can be optionally
prefixed by a '-'.  So all of the following are valid

    -AutoClose
    -autoclose
    AUTOCLOSE
    autoclose

OPTS is a combination of the following options:

=over 5

=item C<< AutoClose => 0|1 >>

This option is only valid when the C<$input> parameter is a filehandle. If
specified, and the value is true, it will result in the file being closed once
either the C<close> method is called or the IO::Uncompress::AnyUncompress object is
destroyed.

This parameter defaults to 0.

=item C<< MultiStream => 0|1 >>

Allows multiple concatenated compressed streams to be treated as a single
compressed stream. Decompression will stop once either the end of the
file/buffer is reached, an error is encountered (premature eof, corrupt
compressed data) or the end of a stream is not immediately followed by the
start of another stream.

This parameter defaults to 0.

=item C<< Prime => $string >>

This option will uncompress the contents of C<$string> before processing the
input file/buffer.

This option can be useful when the compressed data is embedded in another
file/data structure and it is not possible to work out where the compressed
data begins without having to read the first few bytes. If this is the
case, the uncompression can be I<primed> with these bytes using this
option.

=item C<< Transparent => 0|1 >>

If this option is set and the input file/buffer is not compressed data,
the module will allow reading of it anyway.

In addition, if the input file/buffer does contain compressed data and
there is non-compressed data immediately following it, setting this option
will make this module treat the whole file/buffer as a single data stream.

This option defaults to 1.

=item C<< BlockSize => $num >>

When reading the compressed input data, IO::Uncompress::AnyUncompress will read it in
blocks of C<$num> bytes.

This option defaults to 4096.

=item C<< InputLength => $size >>

When present this option will limit the number of compressed bytes read
from the input file/buffer to C<$size>. This option can be used in the
situation where there is useful data directly after the compressed data
stream and you know beforehand the exact length of the compressed data
stream.

This option is mostly used when reading from a filehandle, in which case
the file pointer will be left pointing to the first byte directly after the
compressed data stream.

This option defaults to off.

=item C<< Append => 0|1 >>

This option controls what the C<read> method does with uncompressed data.

If set to 1, all uncompressed data will be appended to the output parameter
of the C<read> method.

If set to 0, the contents of the output parameter of the C<read> method
will be overwritten by the uncompressed data.

Defaults to 0.

=item C<< Strict => 0|1 >>

This option controls whether the extra checks defined below are used when
carrying out the decompression. When Strict is on, the extra tests are
carried out, when Strict is off they are not.

The default for this option is off.

=item C<< RawInflate => 0|1 >>

When auto-detecting the compressed format, try to test for raw-deflate (RFC
1951) content using the C<IO::Uncompress::RawInflate> module.

The reason this is not default behaviour is because RFC 1951 content can
only be detected by attempting to uncompress it. This process is error
prone and can result is false positives.

Defaults to 0.

=item C<< UnLzma => 0|1 >>

When auto-detecting the compressed format, try to test for lzma_alone
content using the C<IO::Uncompress::UnLzma> module.

The reason this is not default behaviour is because lzma_alone content can
only be detected by attempting to uncompress it. This process is error
prone and can result is false positives.

Defaults to 0.

=back

=head2 Examples

TODO

=head1 Methods

=head2 read

Usage is

    $status = $z->read($buffer)

Reads a block of compressed data (the size of the compressed block is
determined by the C<Buffer> option in the constructor), uncompresses it and
writes any uncompressed data into C<$buffer>. If the C<Append> parameter is
set in the constructor, the uncompressed data will be appended to the
C<$buffer> parameter. Otherwise C<$buffer> will be overwritten.

Returns the number of uncompressed bytes written to C<$buffer>, zero if eof
or a negative number on error.

=head2 read

Usage is

    $status = $z->read($buffer, $length)
    $status = $z->read($buffer, $length, $offset)

    $status = read($z, $buffer, $length)
    $status = read($z, $buffer, $length, $offset)

Attempt to read C<$length> bytes of uncompressed data into C<$buffer>.

The main difference between this form of the C<read> method and the
previous one, is that this one will attempt to return I<exactly> C<$length>
bytes. The only circumstances that this function will not is if end-of-file
or an IO error is encountered.

Returns the number of uncompressed bytes written to C<$buffer>, zero if eof
or a negative number on error.

=head2 getline

Usage is

    $line = $z->getline()
    $line = <$z>

Reads a single line.

This method fully supports the use of the variable C<$/> (or
C<$INPUT_RECORD_SEPARATOR> or C<$RS> when C<English> is in use) to
determine what constitutes an end of line. Paragraph mode, record mode and
file slurp mode are all supported.

=head2 getc

Usage is

    $char = $z->getc()

Read a single character.

=head2 ungetc

Usage is

    $char = $z->ungetc($string)

=head2 getHeaderInfo

Usage is

    $hdr  = $z->getHeaderInfo();
    @hdrs = $z->getHeaderInfo();

This method returns either a hash reference (in scalar context) or a list
or hash references (in array context) that contains information about each
of the header fields in the compressed data stream(s).

=head2 tell

Usage is

    $z->tell()
    tell $z

Returns the uncompressed file offset.

=head2 eof

Usage is

    $z->eof();
    eof($z);

Returns true if the end of the compressed input stream has been reached.

=head2 seek

    $z->seek($position, $whence);
    seek($z, $position, $whence);

Provides a sub-set of the C<seek> functionality, with the restriction
that it is only legal to seek forward in the input file/buffer.
It is a fatal error to attempt to seek backward.

Note that the implementation of C<seek> in this module does not provide
true random access to a compressed file/buffer. It  works by uncompressing
data from the current offset in the file/buffer until it reaches the
uncompressed offset specified in the parameters to C<seek>. For very small
files this may be acceptable behaviour. For large files it may cause an
unacceptable delay.

The C<$whence> parameter takes one the usual values, namely SEEK_SET,
SEEK_CUR or SEEK_END.

Returns 1 on success, 0 on failure.

=head2 binmode

Usage is

    $z->binmode
    binmode $z ;

This is a noop provided for completeness.

=head2 opened

    $z->opened()

Returns true if the object currently refers to a opened file/buffer.

=head2 autoflush

    my $prev = $z->autoflush()
    my $prev = $z->autoflush(EXPR)

If the C<$z> object is associated with a file or a filehandle, this method
returns the current autoflush setting for the underlying filehandle. If
C<EXPR> is present, and is non-zero, it will enable flushing after every
write/print operation.

If C<$z> is associated with a buffer, this method has no effect and always
returns C<undef>.

B<Note> that the special variable C<$|> B<cannot> be used to set or
retrieve the autoflush setting.

=head2 input_line_number

    $z->input_line_number()
    $z->input_line_number(EXPR)

Returns the current uncompressed line number. If C<EXPR> is present it has
the effect of setting the line number. Note that setting the line number
does not change the current position within the file/buffer being read.

The contents of C<$/> are used to determine what constitutes a line
terminator.

=head2 fileno

    $z->fileno()
    fileno($z)

If the C<$z> object is associated with a file or a filehandle, C<fileno>
will return the underlying file descriptor. Once the C<close> method is
called C<fileno> will return C<undef>.

If the C<$z> object is associated with a buffer, this method will return
C<undef>.

=head2 close

    $z->close() ;
    close $z ;

Closes the output file/buffer.

For most versions of Perl this method will be automatically invoked if
the IO::Uncompress::AnyUncompress object is destroyed (either explicitly or by the
variable with the reference to the object going out of scope). The
exceptions are Perl versions 5.005 through 5.00504 and 5.8.0. In
these cases, the C<close> method will be called automatically, but
not until global destruction of all live objects when the program is
terminating.

Therefore, if you want your scripts to be able to run on all versions
of Perl, you should call C<close> explicitly and not rely on automatic
closing.

Returns true on success, otherwise 0.

If the C<AutoClose> option has been enabled when the IO::Uncompress::AnyUncompress
object was created, and the object is associated with a file, the
underlying file will also be closed.

=head2 nextStream

Usage is

    my $status = $z->nextStream();

Skips to the next compressed data stream in the input file/buffer. If a new
compressed data stream is found, the eof marker will be cleared and C<$.>
will be reset to 0.

Returns 1 if a new stream was found, 0 if none was found, and -1 if an
error was encountered.

=head2 trailingData

Usage is

    my $data = $z->trailingData();

Returns the data, if any, that is present immediately after the compressed
data stream once uncompression is complete. It only makes sense to call
this method once the end of the compressed data stream has been
encountered.

This option can be used when there is useful information immediately
following the compressed data stream, and you don't know the length of the
compressed data stream.

If the input is a buffer, C<trailingData> will return everything from the
end of the compressed data stream to the end of the buffer.

If the input is a filehandle, C<trailingData> will return the data that is
left in the filehandle input buffer once the end of the compressed data
stream has been reached. You can then use the filehandle to read the rest
of the input file.

Don't bother using C<trailingData> if the input is a filename.

If you know the length of the compressed data stream before you start
uncompressing, you can avoid having to use C<trailingData> by setting the
C<InputLength> option in the constructor.

=head1 Importing

No symbolic constants are required by IO::Uncompress::AnyUncompress at present.

=over 5

=item :all

Imports C<anyuncompress> and C<$AnyUncompressError>.
Same as doing this

    use IO::Uncompress::AnyUncompress qw(anyuncompress $AnyUncompressError) ;

=back

=head1 EXAMPLES

=head1 SUPPORT

General feedback/questions/bug reports should be sent to
L<https://github.com/pmqs/IO-Compress/issues> (preferred) or
L<https://rt.cpan.org/Public/Dist/Display.html?Name=IO-Compress>.

=head1 SEE ALSO

L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzip>, L<IO::Uncompress::UnLzip>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Compress::Zstd>, L<IO::Uncompress::UnZstd>, L<IO::Uncompress::AnyInflate>

L<IO::Compress::FAQ|IO::Compress::FAQ>

L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>,
L<Archive::Tar|Archive::Tar>,
L<IO::Zlib|IO::Zlib>

=head1 AUTHOR

This module was written by Paul Marquess, C<pmqs@cpan.org>.

=head1 MODIFICATION HISTORY

See the Changes file.

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2005-2021 Paul Marquess. All rights reserved.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
                                                                                                                                                                       Uncompress/Adapter/Identity.pm                                                                      0000644                 00000010707 00000000000 0012357 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       package IO::Uncompress::Adapter::Identity;

use warnings;
use strict;
use bytes;

use IO::Compress::Base::Common  2.101 qw(:Status);
use IO::Compress::Zip::Constants ;

our ($VERSION);

$VERSION = '2.102';

use Compress::Raw::Zlib  2.101 ();

sub mkUncompObject
{
    my $streaming = shift;
    my $zip64 = shift;

    my $crc32 = 1; #shift ;
    my $adler32 = shift;

    bless { 'CompSize'   => U64->new(), # 0,
            'UnCompSize' => 0,
            'wantCRC32'  => $crc32,
            'CRC32'      => Compress::Raw::Zlib::crc32(''),
            'wantADLER32'=> $adler32,
            'ADLER32'    => Compress::Raw::Zlib::adler32(''),
            'ConsumesInput' => 1,
            'Streaming'  => $streaming,
            'Zip64'      => $zip64,
            'DataHdrSize'  => $zip64 ? 24 :  16,
            'Pending'   => '',

          } ;
}


sub uncompr
{
    my $self = shift;
    my $in = $_[0];
    my $eof = $_[2];

    my $len = length $$in;
    my $remainder = '';

    if (defined $$in && $len) {

        if ($self->{Streaming}) {

            if (length $self->{Pending}) {
                $$in = $self->{Pending} . $$in ;
                $len = length $$in;
                $self->{Pending} = '';
            }

            my $ind = index($$in, "\x50\x4b\x07\x08");

            if ($ind < 0) {
                $len = length $$in;
                if ($len >= 3 && substr($$in, -3) eq "\x50\x4b\x07") {
                    $ind = $len - 3 ;
                }
                elsif ($len >= 2 && substr($$in, -2) eq "\x50\x4b") {
                    $ind = $len - 2 ;
                }
                elsif ($len >= 1 && substr($$in, -1) eq "\x50") {
                    $ind = $len - 1 ;
                }
            }

            if ($ind >= 0) {
                $remainder = substr($$in, $ind) ;
                substr($$in, $ind) = '' ;
            }
        }

        if (length $remainder && length $remainder < $self->{DataHdrSize}) {
            $self->{Pending} = $remainder ;
            $remainder = '';
        }
        elsif (length $remainder >= $self->{DataHdrSize}) {
            my $crc = unpack "V", substr($remainder, 4);
            if ($crc == Compress::Raw::Zlib::crc32($$in,  $self->{CRC32})) {
                my ($l1, $l2) ;

                if ($self->{Zip64}) {
                    $l1 = U64::newUnpack_V64(substr($remainder, 8));
                    $l2 = U64::newUnpack_V64(substr($remainder, 16));
                }
                else {
                    $l1 = U64::newUnpack_V32(substr($remainder, 8));
                    $l2 = U64::newUnpack_V32(substr($remainder, 12));
                }

                my $newLen = $self->{CompSize}->clone();
                $newLen->add(length $$in);
                if ($l1->equal($l2) && $l1->equal($newLen) ) {
                    $eof = 1;
                }
                else {
                    $$in .= substr($remainder, 0, 4) ;
                    $remainder       = substr($remainder, 4);
                    #$self->{Pending} = substr($remainder, 4);
                    #$remainder = '';
                    $eof = 0;
                }
            }
            else {
                $$in .= substr($remainder, 0, 4) ;
                $remainder       = substr($remainder, 4);
                #$self->{Pending} = substr($remainder, 4);
                #$remainder = '';
                $eof = 0;
            }
        }

        if (length $$in) {
            $self->{CompSize}->add(length $$in) ;

            $self->{CRC32} = Compress::Raw::Zlib::crc32($$in,  $self->{CRC32})
                if $self->{wantCRC32};

            $self->{ADLER32} = Compress::Zlib::adler32($$in,  $self->{ADLER32})
                if $self->{wantADLER32};
        }

        ${ $_[1] } .= $$in;
        $$in  = $remainder;
    }

    return STATUS_ENDSTREAM if $eof;
    return STATUS_OK ;
}

sub reset
{
    my $self = shift;

    $self->{CompSize}->reset();
    $self->{UnCompSize} = 0;
    $self->{CRC32}      = Compress::Raw::Zlib::crc32('');
    $self->{ADLER32}    = Compress::Raw::Zlib::adler32('');

    return STATUS_OK ;
}

#sub count
#{
#    my $self = shift ;
#    return $self->{UnCompSize} ;
#}

sub compressedBytes
{
    my $self = shift ;
    return $self->{CompSize} ;
}

sub uncompressedBytes
{
    my $self = shift ;
    return $self->{CompSize} ;
}

sub sync
{
    return STATUS_OK ;
}

sub crc32
{
    my $self = shift ;
    return $self->{CRC32};
}

sub adler32
{
    my $self = shift ;
    return $self->{ADLER32};
}


1;

__END__
                                                         Uncompress/Adapter/Bunzip2.pm                                                                       0000644                 00000003753 00000000000 0012122 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       package IO::Uncompress::Adapter::Bunzip2;

use strict;
use warnings;
use bytes;

use IO::Compress::Base::Common 2.101 qw(:Status);

use Compress::Raw::Bzip2 2.101 ;

our ($VERSION, @ISA);
$VERSION = '2.102';

sub mkUncompObject
{
    my $small     = shift || 0;
    my $verbosity = shift || 0;

    my ($inflate, $status) = Compress::Raw::Bunzip2->new(1, 1, $small, $verbosity, 1);

    return (undef, "Could not create Inflation object: $status", $status)
        if $status != BZ_OK ;

    return bless {'Inf'           => $inflate,
                  'CompSize'      => 0,
                  'UnCompSize'    => 0,
                  'Error'         => '',
                  'ConsumesInput' => 1,
                 }  ;

}

sub uncompr
{
    my $self = shift ;
    my $from = shift ;
    my $to   = shift ;
    my $eof  = shift ;

    my $inf   = $self->{Inf};

    my $status = $inf->bzinflate($from, $to);
    $self->{ErrorNo} = $status;

    if ($status != BZ_OK && $status != BZ_STREAM_END )
    {
        $self->{Error} = "Inflation Error: $status";
        return STATUS_ERROR;
    }


    return STATUS_OK        if $status == BZ_OK ;
    return STATUS_ENDSTREAM if $status == BZ_STREAM_END ;
    return STATUS_ERROR ;
}


sub reset
{
    my $self = shift ;

    my ($inf, $status) = Compress::Raw::Bunzip2->new();
    $self->{ErrorNo} = ($status == BZ_OK) ? 0 : $status ;

    if ($status != BZ_OK)
    {
        $self->{Error} = "Cannot create Inflate object: $status";
        return STATUS_ERROR;
    }

    $self->{Inf} = $inf;

    return STATUS_OK ;
}

sub compressedBytes
{
    my $self = shift ;
    $self->{Inf}->compressedBytes();
}

sub uncompressedBytes
{
    my $self = shift ;
    $self->{Inf}->uncompressedBytes();
}

sub crc32
{
    my $self = shift ;
    #$self->{Inf}->crc32();
}

sub adler32
{
    my $self = shift ;
    #$self->{Inf}->adler32();
}

sub sync
{
    my $self = shift ;
    #( $self->{Inf}->inflateSync(@_) == BZ_OK)
    #        ? STATUS_OK
    #        : STATUS_ERROR ;
}


1;

__END__
                     Uncompress/Adapter/Inflate.pm                                                                       0000644                 00000006273 00000000000 0012153 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       package IO::Uncompress::Adapter::Inflate;

use strict;
use warnings;
use bytes;

use IO::Compress::Base::Common  2.101 qw(:Status);
use Compress::Raw::Zlib  2.101 qw(Z_OK Z_BUF_ERROR Z_STREAM_END Z_FINISH MAX_WBITS);

our ($VERSION);
$VERSION = '2.102';



sub mkUncompObject
{
    my $crc32   = shift || 1;
    my $adler32 = shift || 1;
    my $scan    = shift || 0;

    my $inflate ;
    my $status ;

    if ($scan)
    {
        ($inflate, $status) = Compress::Raw::Zlib::InflateScan->new(
                                    #LimitOutput  => 1,
                                    CRC32        => $crc32,
                                    ADLER32      => $adler32,
                                    WindowBits   => - MAX_WBITS );
    }
    else
    {
        ($inflate, $status) = Compress::Raw::Zlib::Inflate->new(
                                    AppendOutput => 1,
                                    LimitOutput  => 1,
                                    CRC32        => $crc32,
                                    ADLER32      => $adler32,
                                    WindowBits   => - MAX_WBITS );
    }

    return (undef, "Could not create Inflation object: $status", $status)
        if $status != Z_OK ;

    return bless {'Inf'        => $inflate,
                  'CompSize'   => 0,
                  'UnCompSize' => 0,
                  'Error'      => '',
                  'ConsumesInput' => 1,
                 } ;

}

sub uncompr
{
    my $self = shift ;
    my $from = shift ;
    my $to   = shift ;
    my $eof  = shift ;

    my $inf   = $self->{Inf};

    my $status = $inf->inflate($from, $to, $eof);
    $self->{ErrorNo} = $status;
    if ($status != Z_OK && $status != Z_STREAM_END && $status != Z_BUF_ERROR)
    {
        $self->{Error} = "Inflation Error: $status";
        return STATUS_ERROR;
    }

    return STATUS_OK        if $status == Z_BUF_ERROR ; # ???
    return STATUS_OK        if $status == Z_OK ;
    return STATUS_ENDSTREAM if $status == Z_STREAM_END ;
    return STATUS_ERROR ;
}

sub reset
{
    my $self = shift ;
    $self->{Inf}->inflateReset();

    return STATUS_OK ;
}

#sub count
#{
#    my $self = shift ;
#    $self->{Inf}->inflateCount();
#}

sub crc32
{
    my $self = shift ;
    $self->{Inf}->crc32();
}

sub compressedBytes
{
    my $self = shift ;
    $self->{Inf}->compressedBytes();
}

sub uncompressedBytes
{
    my $self = shift ;
    $self->{Inf}->uncompressedBytes();
}

sub adler32
{
    my $self = shift ;
    $self->{Inf}->adler32();
}

sub sync
{
    my $self = shift ;
    ( $self->{Inf}->inflateSync(@_) == Z_OK)
            ? STATUS_OK
            : STATUS_ERROR ;
}


sub getLastBlockOffset
{
    my $self = shift ;
    $self->{Inf}->getLastBlockOffset();
}

sub getEndOffset
{
    my $self = shift ;
    $self->{Inf}->getEndOffset();
}

sub resetLastBlockByte
{
    my $self = shift ;
    $self->{Inf}->resetLastBlockByte(@_);
}

sub createDeflateStream
{
    my $self = shift ;
    my $deflate = $self->{Inf}->createDeflateStream(@_);
    return bless {'Def'        => $deflate,
                  'CompSize'   => 0,
                  'UnCompSize' => 0,
                  'Error'      => '',
                 }, 'IO::Compress::Adapter::Deflate';
}

1;


__END__
                                                                                                                                                                                                                                                                                                                                     Uncompress/Gunzip.pm                                                                                0000644                 00000076630 00000000000 0010471 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       
package IO::Uncompress::Gunzip ;

require 5.006 ;

# for RFC1952

use strict ;
use warnings;
use bytes;

use IO::Uncompress::RawInflate 2.101 ;

use Compress::Raw::Zlib 2.101 () ;
use IO::Compress::Base::Common 2.101 qw(:Status );
use IO::Compress::Gzip::Constants 2.101 ;
use IO::Compress::Zlib::Extra 2.101 ;

require Exporter ;

our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $GunzipError);

@ISA = qw(IO::Uncompress::RawInflate Exporter);
@EXPORT_OK = qw( $GunzipError gunzip );
%EXPORT_TAGS = %IO::Uncompress::RawInflate::DEFLATE_CONSTANTS ;
push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
Exporter::export_ok_tags('all');

$GunzipError = '';

$VERSION = '2.102';

sub new
{
    my $class = shift ;
    $GunzipError = '';
    my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$GunzipError);

    $obj->_create(undef, 0, @_);
}

sub gunzip
{
    my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$GunzipError);
    return $obj->_inf(@_) ;
}

sub getExtraParams
{
    return ( 'parseextra' => [IO::Compress::Base::Common::Parse_boolean,  0] ) ;
}

sub ckParams
{
    my $self = shift ;
    my $got = shift ;

    # gunzip always needs crc32
    $got->setValue('crc32' => 1);

    return 1;
}

sub ckMagic
{
    my $self = shift;

    my $magic ;
    $self->smartReadExact(\$magic, GZIP_ID_SIZE);

    *$self->{HeaderPending} = $magic ;

    return $self->HeaderError("Minimum header size is " .
                              GZIP_MIN_HEADER_SIZE . " bytes")
        if length $magic != GZIP_ID_SIZE ;

    return $self->HeaderError("Bad Magic")
        if ! isGzipMagic($magic) ;

    *$self->{Type} = 'rfc1952';

    return $magic ;
}

sub readHeader
{
    my $self = shift;
    my $magic = shift;

    return $self->_readGzipHeader($magic);
}

sub chkTrailer
{
    my $self = shift;
    my $trailer = shift;

    # Check CRC & ISIZE
    my ($CRC32, $ISIZE) = unpack("V V", $trailer) ;
    *$self->{Info}{CRC32} = $CRC32;
    *$self->{Info}{ISIZE} = $ISIZE;

    if (*$self->{Strict}) {
        return $self->TrailerError("CRC mismatch")
            if $CRC32 != *$self->{Uncomp}->crc32() ;

        my $exp_isize = *$self->{UnCompSize}->get32bit();
        return $self->TrailerError("ISIZE mismatch. Got $ISIZE"
                                  . ", expected $exp_isize")
            if $ISIZE != $exp_isize ;
    }

    return STATUS_OK;
}

sub isGzipMagic
{
    my $buffer = shift ;
    return 0 if length $buffer < GZIP_ID_SIZE ;
    my ($id1, $id2) = unpack("C C", $buffer) ;
    return $id1 == GZIP_ID1 && $id2 == GZIP_ID2 ;
}

sub _readFullGzipHeader($)
{
    my ($self) = @_ ;
    my $magic = '' ;

    $self->smartReadExact(\$magic, GZIP_ID_SIZE);

    *$self->{HeaderPending} = $magic ;

    return $self->HeaderError("Minimum header size is " .
                              GZIP_MIN_HEADER_SIZE . " bytes")
        if length $magic != GZIP_ID_SIZE ;


    return $self->HeaderError("Bad Magic")
        if ! isGzipMagic($magic) ;

    my $status = $self->_readGzipHeader($magic);
    delete *$self->{Transparent} if ! defined $status ;
    return $status ;
}

sub _readGzipHeader($)
{
    my ($self, $magic) = @_ ;
    my ($HeaderCRC) ;
    my ($buffer) = '' ;

    $self->smartReadExact(\$buffer, GZIP_MIN_HEADER_SIZE - GZIP_ID_SIZE)
        or return $self->HeaderError("Minimum header size is " .
                                     GZIP_MIN_HEADER_SIZE . " bytes") ;

    my $keep = $magic . $buffer ;
    *$self->{HeaderPending} = $keep ;

    # now split out the various parts
    my ($cm, $flag, $mtime, $xfl, $os) = unpack("C C V C C", $buffer) ;

    $cm == GZIP_CM_DEFLATED
        or return $self->HeaderError("Not Deflate (CM is $cm)") ;

    # check for use of reserved bits
    return $self->HeaderError("Use of Reserved Bits in FLG field.")
        if $flag & GZIP_FLG_RESERVED ;

    my $EXTRA ;
    my @EXTRA = () ;
    if ($flag & GZIP_FLG_FEXTRA) {
        $EXTRA = "" ;
        $self->smartReadExact(\$buffer, GZIP_FEXTRA_HEADER_SIZE)
            or return $self->TruncatedHeader("FEXTRA Length") ;

        my ($XLEN) = unpack("v", $buffer) ;
        $self->smartReadExact(\$EXTRA, $XLEN)
            or return $self->TruncatedHeader("FEXTRA Body");
        $keep .= $buffer . $EXTRA ;

        if ($XLEN && *$self->{'ParseExtra'}) {
            my $bad = IO::Compress::Zlib::Extra::parseRawExtra($EXTRA,
                                                \@EXTRA, 1, 1);
            return $self->HeaderError($bad)
                if defined $bad;
        }
    }

    my $origname ;
    if ($flag & GZIP_FLG_FNAME) {
        $origname = "" ;
        while (1) {
            $self->smartReadExact(\$buffer, 1)
                or return $self->TruncatedHeader("FNAME");
            last if $buffer eq GZIP_NULL_BYTE ;
            $origname .= $buffer
        }
        $keep .= $origname . GZIP_NULL_BYTE ;

        return $self->HeaderError("Non ISO 8859-1 Character found in Name")
            if *$self->{Strict} && $origname =~ /$GZIP_FNAME_INVALID_CHAR_RE/o ;
    }

    my $comment ;
    if ($flag & GZIP_FLG_FCOMMENT) {
        $comment = "";
        while (1) {
            $self->smartReadExact(\$buffer, 1)
                or return $self->TruncatedHeader("FCOMMENT");
            last if $buffer eq GZIP_NULL_BYTE ;
            $comment .= $buffer
        }
        $keep .= $comment . GZIP_NULL_BYTE ;

        return $self->HeaderError("Non ISO 8859-1 Character found in Comment")
            if *$self->{Strict} && $comment =~ /$GZIP_FCOMMENT_INVALID_CHAR_RE/o ;
    }

    if ($flag & GZIP_FLG_FHCRC) {
        $self->smartReadExact(\$buffer, GZIP_FHCRC_SIZE)
            or return $self->TruncatedHeader("FHCRC");

        $HeaderCRC = unpack("v", $buffer) ;
        my $crc16 = Compress::Raw::Zlib::crc32($keep) & 0xFF ;

        return $self->HeaderError("CRC16 mismatch.")
            if *$self->{Strict} && $crc16 != $HeaderCRC;

        $keep .= $buffer ;
    }

    # Assume compression method is deflated for xfl tests
    #if ($xfl) {
    #}

    *$self->{Type} = 'rfc1952';

    return {
        'Type'          => 'rfc1952',
        'FingerprintLength'  => 2,
        'HeaderLength'  => length $keep,
        'TrailerLength' => GZIP_TRAILER_SIZE,
        'Header'        => $keep,
        'isMinimalHeader' => $keep eq GZIP_MINIMUM_HEADER ? 1 : 0,

        'MethodID'      => $cm,
        'MethodName'    => $cm == GZIP_CM_DEFLATED ? "Deflated" : "Unknown" ,
        'TextFlag'      => $flag & GZIP_FLG_FTEXT ? 1 : 0,
        'HeaderCRCFlag' => $flag & GZIP_FLG_FHCRC ? 1 : 0,
        'NameFlag'      => $flag & GZIP_FLG_FNAME ? 1 : 0,
        'CommentFlag'   => $flag & GZIP_FLG_FCOMMENT ? 1 : 0,
        'ExtraFlag'     => $flag & GZIP_FLG_FEXTRA ? 1 : 0,
        'Name'          => $origname,
        'Comment'       => $comment,
        'Time'          => $mtime,
        'OsID'          => $os,
        'OsName'        => defined $GZIP_OS_Names{$os}
                                 ? $GZIP_OS_Names{$os} : "Unknown",
        'HeaderCRC'     => $HeaderCRC,
        'Flags'         => $flag,
        'ExtraFlags'    => $xfl,
        'ExtraFieldRaw' => $EXTRA,
        'ExtraField'    => [ @EXTRA ],


        #'CompSize'=> $compsize,
        #'CRC32'=> $CRC32,
        #'OrigSize'=> $ISIZE,
      }
}


1;

__END__


=head1 NAME

IO::Uncompress::Gunzip - Read RFC 1952 files/buffers

=head1 SYNOPSIS

    use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ;

    my $status = gunzip $input => $output [,OPTS]
        or die "gunzip failed: $GunzipError\n";

    my $z = IO::Uncompress::Gunzip->new( $input [OPTS] )
        or die "gunzip failed: $GunzipError\n";

    $status = $z->read($buffer)
    $status = $z->read($buffer, $length)
    $status = $z->read($buffer, $length, $offset)
    $line = $z->getline()
    $char = $z->getc()
    $char = $z->ungetc()
    $char = $z->opened()

    $status = $z->inflateSync()

    $data = $z->trailingData()
    $status = $z->nextStream()
    $data = $z->getHeaderInfo()
    $z->tell()
    $z->seek($position, $whence)
    $z->binmode()
    $z->fileno()
    $z->eof()
    $z->close()

    $GunzipError ;

    # IO::File mode

    <$z>
    read($z, $buffer);
    read($z, $buffer, $length);
    read($z, $buffer, $length, $offset);
    tell($z)
    seek($z, $position, $whence)
    binmode($z)
    fileno($z)
    eof($z)
    close($z)

=head1 DESCRIPTION

This module provides a Perl interface that allows the reading of
files/buffers that conform to RFC 1952.

For writing RFC 1952 files/buffers, see the companion module IO::Compress::Gzip.

=head1 Functional Interface

A top-level function, C<gunzip>, is provided to carry out
"one-shot" uncompression between buffers and/or files. For finer
control over the uncompression process, see the L</"OO Interface">
section.

    use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ;

    gunzip $input_filename_or_reference => $output_filename_or_reference [,OPTS]
        or die "gunzip failed: $GunzipError\n";

The functional interface needs Perl5.005 or better.

=head2 gunzip $input_filename_or_reference => $output_filename_or_reference [, OPTS]

C<gunzip> expects at least two parameters,
C<$input_filename_or_reference> and C<$output_filename_or_reference>
and zero or more optional parameters (see L</Optional Parameters>)

=head3 The C<$input_filename_or_reference> parameter

The parameter, C<$input_filename_or_reference>, is used to define the
source of the compressed data.

It can take one of the following forms:

=over 5

=item A filename

If the C<$input_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename. This file will be opened for reading and the
input data will be read from it.

=item A filehandle

If the C<$input_filename_or_reference> parameter is a filehandle, the input
data will be read from it.  The string '-' can be used as an alias for
standard input.

=item A scalar reference

If C<$input_filename_or_reference> is a scalar reference, the input data
will be read from C<$$input_filename_or_reference>.

=item An array reference

If C<$input_filename_or_reference> is an array reference, each element in
the array must be a filename.

The input data will be read from each file in turn.

The complete array will be walked to ensure that it only
contains valid filenames before any data is uncompressed.

=item An Input FileGlob string

If C<$input_filename_or_reference> is a string that is delimited by the
characters "<" and ">" C<gunzip> will assume that it is an
I<input fileglob string>. The input is the list of files that match the
fileglob.

See L<File::GlobMapper|File::GlobMapper> for more details.

=back

If the C<$input_filename_or_reference> parameter is any other type,
C<undef> will be returned.

=head3 The C<$output_filename_or_reference> parameter

The parameter C<$output_filename_or_reference> is used to control the
destination of the uncompressed data. This parameter can take one of
these forms.

=over 5

=item A filename

If the C<$output_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename.  This file will be opened for writing and the
uncompressed data will be written to it.

=item A filehandle

If the C<$output_filename_or_reference> parameter is a filehandle, the
uncompressed data will be written to it.  The string '-' can be used as
an alias for standard output.

=item A scalar reference

If C<$output_filename_or_reference> is a scalar reference, the
uncompressed data will be stored in C<$$output_filename_or_reference>.

=item An Array Reference

If C<$output_filename_or_reference> is an array reference,
the uncompressed data will be pushed onto the array.

=item An Output FileGlob

If C<$output_filename_or_reference> is a string that is delimited by the
characters "<" and ">" C<gunzip> will assume that it is an
I<output fileglob string>. The output is the list of files that match the
fileglob.

When C<$output_filename_or_reference> is an fileglob string,
C<$input_filename_or_reference> must also be a fileglob string. Anything
else is an error.

See L<File::GlobMapper|File::GlobMapper> for more details.

=back

If the C<$output_filename_or_reference> parameter is any other type,
C<undef> will be returned.

=head2 Notes

When C<$input_filename_or_reference> maps to multiple compressed
files/buffers and C<$output_filename_or_reference> is
a single file/buffer, after uncompression C<$output_filename_or_reference> will contain a
concatenation of all the uncompressed data from each of the input
files/buffers.

=head2 Optional Parameters

The optional parameters for the one-shot function C<gunzip>
are (for the most part) identical to those used with the OO interface defined in the
L</"Constructor Options"> section. The exceptions are listed below

=over 5

=item C<< AutoClose => 0|1 >>

This option applies to any input or output data streams to
C<gunzip> that are filehandles.

If C<AutoClose> is specified, and the value is true, it will result in all
input and/or output filehandles being closed once C<gunzip> has
completed.

This parameter defaults to 0.

=item C<< BinModeOut => 0|1 >>

This option is now a no-op. All files will be written  in binmode.

=item C<< Append => 0|1 >>

The behaviour of this option is dependent on the type of output data
stream.

=over 5

=item * A Buffer

If C<Append> is enabled, all uncompressed data will be append to the end of
the output buffer. Otherwise the output buffer will be cleared before any
uncompressed data is written to it.

=item * A Filename

If C<Append> is enabled, the file will be opened in append mode. Otherwise
the contents of the file, if any, will be truncated before any uncompressed
data is written to it.

=item * A Filehandle

If C<Append> is enabled, the filehandle will be positioned to the end of
the file via a call to C<seek> before any uncompressed data is
written to it.  Otherwise the file pointer will not be moved.

=back

When C<Append> is specified, and set to true, it will I<append> all uncompressed
data to the output data stream.

So when the output is a filehandle it will carry out a seek to the eof
before writing any uncompressed data. If the output is a filename, it will be opened for
appending. If the output is a buffer, all uncompressed data will be
appended to the existing buffer.

Conversely when C<Append> is not specified, or it is present and is set to
false, it will operate as follows.

When the output is a filename, it will truncate the contents of the file
before writing any uncompressed data. If the output is a filehandle
its position will not be changed. If the output is a buffer, it will be
wiped before any uncompressed data is output.

Defaults to 0.

=item C<< MultiStream => 0|1 >>

If the input file/buffer contains multiple compressed data streams, this
option will uncompress the whole lot as a single data stream.

Defaults to 0.

=item C<< TrailingData => $scalar >>

Returns the data, if any, that is present immediately after the compressed
data stream once uncompression is complete.

This option can be used when there is useful information immediately
following the compressed data stream, and you don't know the length of the
compressed data stream.

If the input is a buffer, C<trailingData> will return everything from the
end of the compressed data stream to the end of the buffer.

If the input is a filehandle, C<trailingData> will return the data that is
left in the filehandle input buffer once the end of the compressed data
stream has been reached. You can then use the filehandle to read the rest
of the input file.

Don't bother using C<trailingData> if the input is a filename.

If you know the length of the compressed data stream before you start
uncompressing, you can avoid having to use C<trailingData> by setting the
C<InputLength> option.

=back

=head2 Examples

To read the contents of the file C<file1.txt.gz> and write the
uncompressed data to the file C<file1.txt>.

    use strict ;
    use warnings ;
    use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ;

    my $input = "file1.txt.gz";
    my $output = "file1.txt";
    gunzip $input => $output
        or die "gunzip failed: $GunzipError\n";

To read from an existing Perl filehandle, C<$input>, and write the
uncompressed data to a buffer, C<$buffer>.

    use strict ;
    use warnings ;
    use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ;
    use IO::File ;

    my $input = IO::File->new( "<file1.txt.gz" )
        or die "Cannot open 'file1.txt.gz': $!\n" ;
    my $buffer ;
    gunzip $input => \$buffer
        or die "gunzip failed: $GunzipError\n";

To uncompress all files in the directory "/my/home" that match "*.txt.gz" and store the compressed data in the same directory

    use strict ;
    use warnings ;
    use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ;

    gunzip '</my/home/*.txt.gz>' => '</my/home/#1.txt>'
        or die "gunzip failed: $GunzipError\n";

and if you want to compress each file one at a time, this will do the trick

    use strict ;
    use warnings ;
    use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ;

    for my $input ( glob "/my/home/*.txt.gz" )
    {
        my $output = $input;
        $output =~ s/.gz// ;
        gunzip $input => $output
            or die "Error compressing '$input': $GunzipError\n";
    }

=head1 OO Interface

=head2 Constructor

The format of the constructor for IO::Uncompress::Gunzip is shown below

    my $z = IO::Uncompress::Gunzip->new( $input [OPTS] )
        or die "IO::Uncompress::Gunzip failed: $GunzipError\n";

Returns an C<IO::Uncompress::Gunzip> object on success and undef on failure.
The variable C<$GunzipError> will contain an error message on failure.

If you are running Perl 5.005 or better the object, C<$z>, returned from
IO::Uncompress::Gunzip can be used exactly like an L<IO::File|IO::File> filehandle.
This means that all normal input file operations can be carried out with
C<$z>.  For example, to read a line from a compressed file/buffer you can
use either of these forms

    $line = $z->getline();
    $line = <$z>;

The mandatory parameter C<$input> is used to determine the source of the
compressed data. This parameter can take one of three forms.

=over 5

=item A filename

If the C<$input> parameter is a scalar, it is assumed to be a filename. This
file will be opened for reading and the compressed data will be read from it.

=item A filehandle

If the C<$input> parameter is a filehandle, the compressed data will be
read from it.
The string '-' can be used as an alias for standard input.

=item A scalar reference

If C<$input> is a scalar reference, the compressed data will be read from
C<$$input>.

=back

=head2 Constructor Options

The option names defined below are case insensitive and can be optionally
prefixed by a '-'.  So all of the following are valid

    -AutoClose
    -autoclose
    AUTOCLOSE
    autoclose

OPTS is a combination of the following options:

=over 5

=item C<< AutoClose => 0|1 >>

This option is only valid when the C<$input> parameter is a filehandle. If
specified, and the value is true, it will result in the file being closed once
either the C<close> method is called or the IO::Uncompress::Gunzip object is
destroyed.

This parameter defaults to 0.

=item C<< MultiStream => 0|1 >>

Allows multiple concatenated compressed streams to be treated as a single
compressed stream. Decompression will stop once either the end of the
file/buffer is reached, an error is encountered (premature eof, corrupt
compressed data) or the end of a stream is not immediately followed by the
start of another stream.

This parameter defaults to 0.

=item C<< Prime => $string >>

This option will uncompress the contents of C<$string> before processing the
input file/buffer.

This option can be useful when the compressed data is embedded in another
file/data structure and it is not possible to work out where the compressed
data begins without having to read the first few bytes. If this is the
case, the uncompression can be I<primed> with these bytes using this
option.

=item C<< Transparent => 0|1 >>

If this option is set and the input file/buffer is not compressed data,
the module will allow reading of it anyway.

In addition, if the input file/buffer does contain compressed data and
there is non-compressed data immediately following it, setting this option
will make this module treat the whole file/buffer as a single data stream.

This option defaults to 1.

=item C<< BlockSize => $num >>

When reading the compressed input data, IO::Uncompress::Gunzip will read it in
blocks of C<$num> bytes.

This option defaults to 4096.

=item C<< InputLength => $size >>

When present this option will limit the number of compressed bytes read
from the input file/buffer to C<$size>. This option can be used in the
situation where there is useful data directly after the compressed data
stream and you know beforehand the exact length of the compressed data
stream.

This option is mostly used when reading from a filehandle, in which case
the file pointer will be left pointing to the first byte directly after the
compressed data stream.

This option defaults to off.

=item C<< Append => 0|1 >>

This option controls what the C<read> method does with uncompressed data.

If set to 1, all uncompressed data will be appended to the output parameter
of the C<read> method.

If set to 0, the contents of the output parameter of the C<read> method
will be overwritten by the uncompressed data.

Defaults to 0.

=item C<< Strict => 0|1 >>

This option controls whether the extra checks defined below are used when
carrying out the decompression. When Strict is on, the extra tests are
carried out, when Strict is off they are not.

The default for this option is off.

=over 5

=item 1

If the FHCRC bit is set in the gzip FLG header byte, the CRC16 bytes in the
header must match the crc16 value of the gzip header actually read.

=item 2

If the gzip header contains a name field (FNAME) it consists solely of ISO
8859-1 characters.

=item 3

If the gzip header contains a comment field (FCOMMENT) it consists solely
of ISO 8859-1 characters plus line-feed.

=item 4

If the gzip FEXTRA header field is present it must conform to the sub-field
structure as defined in RFC 1952.

=item 5

The CRC32 and ISIZE trailer fields must be present.

=item 6

The value of the CRC32 field read must match the crc32 value of the
uncompressed data actually contained in the gzip file.

=item 7

The value of the ISIZE fields read must match the length of the
uncompressed data actually read from the file.

=back

=item C<< ParseExtra => 0|1 >>
If the gzip FEXTRA header field is present and this option is set, it will
force the module to check that it conforms to the sub-field structure as
defined in RFC 1952.

If the C<Strict> is on it will automatically enable this option.

Defaults to 0.

=back

=head2 Examples

TODO

=head1 Methods

=head2 read

Usage is

    $status = $z->read($buffer)

Reads a block of compressed data (the size of the compressed block is
determined by the C<Buffer> option in the constructor), uncompresses it and
writes any uncompressed data into C<$buffer>. If the C<Append> parameter is
set in the constructor, the uncompressed data will be appended to the
C<$buffer> parameter. Otherwise C<$buffer> will be overwritten.

Returns the number of uncompressed bytes written to C<$buffer>, zero if eof
or a negative number on error.

=head2 read

Usage is

    $status = $z->read($buffer, $length)
    $status = $z->read($buffer, $length, $offset)

    $status = read($z, $buffer, $length)
    $status = read($z, $buffer, $length, $offset)

Attempt to read C<$length> bytes of uncompressed data into C<$buffer>.

The main difference between this form of the C<read> method and the
previous one, is that this one will attempt to return I<exactly> C<$length>
bytes. The only circumstances that this function will not is if end-of-file
or an IO error is encountered.

Returns the number of uncompressed bytes written to C<$buffer>, zero if eof
or a negative number on error.

=head2 getline

Usage is

    $line = $z->getline()
    $line = <$z>

Reads a single line.

This method fully supports the use of the variable C<$/> (or
C<$INPUT_RECORD_SEPARATOR> or C<$RS> when C<English> is in use) to
determine what constitutes an end of line. Paragraph mode, record mode and
file slurp mode are all supported.

=head2 getc

Usage is

    $char = $z->getc()

Read a single character.

=head2 ungetc

Usage is

    $char = $z->ungetc($string)

=head2 inflateSync

Usage is

    $status = $z->inflateSync()

TODO

=head2 getHeaderInfo

Usage is

    $hdr  = $z->getHeaderInfo();
    @hdrs = $z->getHeaderInfo();

This method returns either a hash reference (in scalar context) or a list
or hash references (in array context) that contains information about each
of the header fields in the compressed data stream(s).

=over 5

=item Name

The contents of the Name header field, if present. If no name is
present, the value will be undef. Note this is different from a zero length
name, which will return an empty string.

=item Comment

The contents of the Comment header field, if present. If no comment is
present, the value will be undef. Note this is different from a zero length
comment, which will return an empty string.

=back

=head2 tell

Usage is

    $z->tell()
    tell $z

Returns the uncompressed file offset.

=head2 eof

Usage is

    $z->eof();
    eof($z);

Returns true if the end of the compressed input stream has been reached.

=head2 seek

    $z->seek($position, $whence);
    seek($z, $position, $whence);

Provides a sub-set of the C<seek> functionality, with the restriction
that it is only legal to seek forward in the input file/buffer.
It is a fatal error to attempt to seek backward.

Note that the implementation of C<seek> in this module does not provide
true random access to a compressed file/buffer. It  works by uncompressing
data from the current offset in the file/buffer until it reaches the
uncompressed offset specified in the parameters to C<seek>. For very small
files this may be acceptable behaviour. For large files it may cause an
unacceptable delay.

The C<$whence> parameter takes one the usual values, namely SEEK_SET,
SEEK_CUR or SEEK_END.

Returns 1 on success, 0 on failure.

=head2 binmode

Usage is

    $z->binmode
    binmode $z ;

This is a noop provided for completeness.

=head2 opened

    $z->opened()

Returns true if the object currently refers to a opened file/buffer.

=head2 autoflush

    my $prev = $z->autoflush()
    my $prev = $z->autoflush(EXPR)

If the C<$z> object is associated with a file or a filehandle, this method
returns the current autoflush setting for the underlying filehandle. If
C<EXPR> is present, and is non-zero, it will enable flushing after every
write/print operation.

If C<$z> is associated with a buffer, this method has no effect and always
returns C<undef>.

B<Note> that the special variable C<$|> B<cannot> be used to set or
retrieve the autoflush setting.

=head2 input_line_number

    $z->input_line_number()
    $z->input_line_number(EXPR)

Returns the current uncompressed line number. If C<EXPR> is present it has
the effect of setting the line number. Note that setting the line number
does not change the current position within the file/buffer being read.

The contents of C<$/> are used to determine what constitutes a line
terminator.

=head2 fileno

    $z->fileno()
    fileno($z)

If the C<$z> object is associated with a file or a filehandle, C<fileno>
will return the underlying file descriptor. Once the C<close> method is
called C<fileno> will return C<undef>.

If the C<$z> object is associated with a buffer, this method will return
C<undef>.

=head2 close

    $z->close() ;
    close $z ;

Closes the output file/buffer.

For most versions of Perl this method will be automatically invoked if
the IO::Uncompress::Gunzip object is destroyed (either explicitly or by the
variable with the reference to the object going out of scope). The
exceptions are Perl versions 5.005 through 5.00504 and 5.8.0. In
these cases, the C<close> method will be called automatically, but
not until global destruction of all live objects when the program is
terminating.

Therefore, if you want your scripts to be able to run on all versions
of Perl, you should call C<close> explicitly and not rely on automatic
closing.

Returns true on success, otherwise 0.

If the C<AutoClose> option has been enabled when the IO::Uncompress::Gunzip
object was created, and the object is associated with a file, the
underlying file will also be closed.

=head2 nextStream

Usage is

    my $status = $z->nextStream();

Skips to the next compressed data stream in the input file/buffer. If a new
compressed data stream is found, the eof marker will be cleared and C<$.>
will be reset to 0.

Returns 1 if a new stream was found, 0 if none was found, and -1 if an
error was encountered.

=head2 trailingData

Usage is

    my $data = $z->trailingData();

Returns the data, if any, that is present immediately after the compressed
data stream once uncompression is complete. It only makes sense to call
this method once the end of the compressed data stream has been
encountered.

This option can be used when there is useful information immediately
following the compressed data stream, and you don't know the length of the
compressed data stream.

If the input is a buffer, C<trailingData> will return everything from the
end of the compressed data stream to the end of the buffer.

If the input is a filehandle, C<trailingData> will return the data that is
left in the filehandle input buffer once the end of the compressed data
stream has been reached. You can then use the filehandle to read the rest
of the input file.

Don't bother using C<trailingData> if the input is a filename.

If you know the length of the compressed data stream before you start
uncompressing, you can avoid having to use C<trailingData> by setting the
C<InputLength> option in the constructor.

=head1 Importing

No symbolic constants are required by IO::Uncompress::Gunzip at present.

=over 5

=item :all

Imports C<gunzip> and C<$GunzipError>.
Same as doing this

    use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ;

=back

=head1 EXAMPLES

=head2 Working with Net::FTP

See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP">

=head1 SUPPORT

General feedback/questions/bug reports should be sent to
L<https://github.com/pmqs/IO-Compress/issues> (preferred) or
L<https://rt.cpan.org/Public/Dist/Display.html?Name=IO-Compress>.

=head1 SEE ALSO

L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzip>, L<IO::Uncompress::UnLzip>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Compress::Zstd>, L<IO::Uncompress::UnZstd>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>

L<IO::Compress::FAQ|IO::Compress::FAQ>

L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>,
L<Archive::Tar|Archive::Tar>,
L<IO::Zlib|IO::Zlib>

For RFC 1950, 1951 and 1952 see
L<http://www.faqs.org/rfcs/rfc1950.html>,
L<http://www.faqs.org/rfcs/rfc1951.html> and
L<http://www.faqs.org/rfcs/rfc1952.html>

The I<zlib> compression library was written by Jean-loup Gailly
C<gzip@prep.ai.mit.edu> and Mark Adler C<madler@alumni.caltech.edu>.

The primary site for the I<zlib> compression library is
L<http://www.zlib.org>.

The primary site for gzip is L<http://www.gzip.org>.

=head1 AUTHOR

This module was written by Paul Marquess, C<pmqs@cpan.org>.

=head1 MODIFICATION HISTORY

See the Changes file.

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2005-2021 Paul Marquess. All rights reserved.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
                                                                                                        Uncompress/RawInflate.pm                                                                            0000644                 00000076141 00000000000 0011246 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       package IO::Uncompress::RawInflate ;
# for RFC1951

use strict ;
use warnings;
use bytes;

use Compress::Raw::Zlib  2.101 ;
use IO::Compress::Base::Common  2.101 qw(:Status );

use IO::Uncompress::Base  2.101 ;
use IO::Uncompress::Adapter::Inflate  2.101 ;

require Exporter ;
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $RawInflateError);

$VERSION = '2.102';
$RawInflateError = '';

@ISA    = qw(IO::Uncompress::Base Exporter);
@EXPORT_OK = qw( $RawInflateError rawinflate ) ;
%DEFLATE_CONSTANTS = ();
%EXPORT_TAGS = %IO::Uncompress::Base::EXPORT_TAGS ;
push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
Exporter::export_ok_tags('all');

#{
#    # Execute at runtime
#    my %bad;
#    for my $module (qw(Compress::Raw::Zlib IO::Compress::Base::Common IO::Uncompress::Base IO::Uncompress::Adapter::Inflate))
#    {
#        my $ver = ${ $module . "::VERSION"} ;
#
#        $bad{$module} = $ver
#            if $ver ne $VERSION;
#    }
#
#    if (keys %bad)
#    {
#        my $string = join "\n", map { "$_ $bad{$_}" } keys %bad;
#        die caller(0)[0] . "needs version $VERSION mismatch\n$string\n";
#    }
#}

sub new
{
    my $class = shift ;
    my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$RawInflateError);
    $obj->_create(undef, 0, @_);
}

sub rawinflate
{
    my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$RawInflateError);
    return $obj->_inf(@_);
}

sub getExtraParams
{
    return ();
}

sub ckParams
{
    my $self = shift ;
    my $got = shift ;

    return 1;
}

sub mkUncomp
{
    my $self = shift ;
    my $got = shift ;

    my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::Inflate::mkUncompObject(
                                                                $got->getValue('crc32'),
                                                                $got->getValue('adler32'),
                                                                $got->getValue('scan'),
                                                            );

    return $self->saveErrorString(undef, $errstr, $errno)
        if ! defined $obj;

    *$self->{Uncomp} = $obj;

     my $magic = $self->ckMagic()
        or return 0;

    *$self->{Info} = $self->readHeader($magic)
        or return undef ;

    return 1;

}


sub ckMagic
{
    my $self = shift;

    return $self->_isRaw() ;
}

sub readHeader
{
    my $self = shift;
    my $magic = shift ;

    return {
        'Type'          => 'rfc1951',
        'FingerprintLength'  => 0,
        'HeaderLength'  => 0,
        'TrailerLength' => 0,
        'Header'        => ''
        };
}

sub chkTrailer
{
    return STATUS_OK ;
}

sub _isRaw
{
    my $self   = shift ;

    my $got = $self->_isRawx(@_);

    if ($got) {
        *$self->{Pending} = *$self->{HeaderPending} ;
    }
    else {
        $self->pushBack(*$self->{HeaderPending});
        *$self->{Uncomp}->reset();
    }
    *$self->{HeaderPending} = '';

    return $got ;
}

sub _isRawx
{
    my $self   = shift ;
    my $magic = shift ;

    $magic = '' unless defined $magic ;

    my $buffer = '';

    $self->smartRead(\$buffer, *$self->{BlockSize}) >= 0
        or return $self->saveErrorString(undef, "No data to read");

    my $temp_buf = $magic . $buffer ;
    *$self->{HeaderPending} = $temp_buf ;
    $buffer = '';
    my $status = *$self->{Uncomp}->uncompr(\$temp_buf, \$buffer, $self->smartEof()) ;

    return $self->saveErrorString(undef, *$self->{Uncomp}{Error}, STATUS_ERROR)
        if $status == STATUS_ERROR;

    $self->pushBack($temp_buf)  ;

    return $self->saveErrorString(undef, "unexpected end of file", STATUS_ERROR)
        if $self->smartEof() && $status != STATUS_ENDSTREAM;

    #my $buf_len = *$self->{Uncomp}->uncompressedBytes();
    my $buf_len = length $buffer;

    if ($status == STATUS_ENDSTREAM) {
        if (*$self->{MultiStream}
                    && (length $temp_buf || ! $self->smartEof())){
            *$self->{NewStream} = 1 ;
            *$self->{EndStream} = 0 ;
        }
        else {
            *$self->{EndStream} = 1 ;
        }
    }
    *$self->{HeaderPending} = $buffer ;
    *$self->{InflatedBytesRead} = $buf_len ;
    *$self->{TotalInflatedBytesRead} += $buf_len ;
    *$self->{Type} = 'rfc1951';

    $self->saveStatus(STATUS_OK);

    return {
        'Type'          => 'rfc1951',
        'HeaderLength'  => 0,
        'TrailerLength' => 0,
        'Header'        => ''
        };
}


sub inflateSync
{
    my $self = shift ;

    # inflateSync is a no-op in Plain mode
    return 1
        if *$self->{Plain} ;

    return 0 if *$self->{Closed} ;
    #return G_EOF if !length *$self->{Pending} && *$self->{EndStream} ;
    return 0 if ! length *$self->{Pending} && *$self->{EndStream} ;

    # Disable CRC check
    *$self->{Strict} = 0 ;

    my $status ;
    while (1)
    {
        my $temp_buf ;

        if (length *$self->{Pending} )
        {
            $temp_buf = *$self->{Pending} ;
            *$self->{Pending} = '';
        }
        else
        {
            $status = $self->smartRead(\$temp_buf, *$self->{BlockSize}) ;
            return $self->saveErrorString(0, "Error Reading Data")
                if $status < 0  ;

            if ($status == 0 ) {
                *$self->{EndStream} = 1 ;
                return $self->saveErrorString(0, "unexpected end of file", STATUS_ERROR);
            }
        }

        $status = *$self->{Uncomp}->sync($temp_buf) ;

        if ($status == STATUS_OK)
        {
            *$self->{Pending} .= $temp_buf ;
            return 1 ;
        }

        last unless $status == STATUS_ERROR ;
    }

    return 0;
}

#sub performScan
#{
#    my $self = shift ;
#
#    my $status ;
#    my $end_offset = 0;
#
#    $status = $self->scan()
#    #or return $self->saveErrorString(undef, "Error Scanning: $$error_ref", $self->errorNo) ;
#        or return $self->saveErrorString(G_ERR, "Error Scanning: $status")
#
#    $status = $self->zap($end_offset)
#        or return $self->saveErrorString(G_ERR, "Error Zapping: $status");
#    #or return $self->saveErrorString(undef, "Error Zapping: $$error_ref", $self->errorNo) ;
#
#    #(*$obj->{Deflate}, $status) = $inf->createDeflate();
#
##    *$obj->{Header} = *$inf->{Info}{Header};
##    *$obj->{UnCompSize_32bit} =
##        *$obj->{BytesWritten} = *$inf->{UnCompSize_32bit} ;
##    *$obj->{CompSize_32bit} = *$inf->{CompSize_32bit} ;
#
#
##    if ( $outType eq 'buffer')
##      { substr( ${ *$self->{Buffer} }, $end_offset) = '' }
##    elsif ($outType eq 'handle' || $outType eq 'filename') {
##        *$self->{FH} = *$inf->{FH} ;
##        delete *$inf->{FH};
##        *$obj->{FH}->flush() ;
##        *$obj->{Handle} = 1 if $outType eq 'handle';
##
##        #seek(*$obj->{FH}, $end_offset, SEEK_SET)
##        *$obj->{FH}->seek($end_offset, SEEK_SET)
##            or return $obj->saveErrorString(undef, $!, $!) ;
##    }
#
#}

sub scan
{
    my $self = shift ;

    return 1 if *$self->{Closed} ;
    return 1 if !length *$self->{Pending} && *$self->{EndStream} ;

    my $buffer = '' ;
    my $len = 0;

    $len = $self->_raw_read(\$buffer, 1)
        while ! *$self->{EndStream} && $len >= 0 ;

    #return $len if $len < 0 ? $len : 0 ;
    return $len < 0 ? 0 : 1 ;
}

sub zap
{
    my $self  = shift ;

    my $headerLength = *$self->{Info}{HeaderLength};
    my $block_offset =  $headerLength + *$self->{Uncomp}->getLastBlockOffset();
    $_[0] = $headerLength + *$self->{Uncomp}->getEndOffset();
    #printf "# End $_[0], headerlen $headerLength \n";;
    #printf "# block_offset $block_offset %x\n", $block_offset;
    my $byte ;
    ( $self->smartSeek($block_offset) &&
      $self->smartRead(\$byte, 1) )
        or return $self->saveErrorString(0, $!, $!);

    #printf "#byte is %x\n", unpack('C*',$byte);
    *$self->{Uncomp}->resetLastBlockByte($byte);
    #printf "#to byte is %x\n", unpack('C*',$byte);

    ( $self->smartSeek($block_offset) &&
      $self->smartWrite($byte) )
        or return $self->saveErrorString(0, $!, $!);

    #$self->smartSeek($end_offset, 1);

    return 1 ;
}

sub createDeflate
{
    my $self  = shift ;
    my ($def, $status) = *$self->{Uncomp}->createDeflateStream(
                                    -AppendOutput   => 1,
                                    -WindowBits => - MAX_WBITS,
                                    -CRC32      => *$self->{Params}->getValue('crc32'),
                                    -ADLER32    => *$self->{Params}->getValue('adler32'),
                                );

    return wantarray ? ($status, $def) : $def ;
}


1;

__END__


=head1 NAME

IO::Uncompress::RawInflate - Read RFC 1951 files/buffers

=head1 SYNOPSIS

    use IO::Uncompress::RawInflate qw(rawinflate $RawInflateError) ;

    my $status = rawinflate $input => $output [,OPTS]
        or die "rawinflate failed: $RawInflateError\n";

    my $z = IO::Uncompress::RawInflate->new( $input [OPTS] )
        or die "rawinflate failed: $RawInflateError\n";

    $status = $z->read($buffer)
    $status = $z->read($buffer, $length)
    $status = $z->read($buffer, $length, $offset)
    $line = $z->getline()
    $char = $z->getc()
    $char = $z->ungetc()
    $char = $z->opened()

    $status = $z->inflateSync()

    $data = $z->trailingData()
    $status = $z->nextStream()
    $data = $z->getHeaderInfo()
    $z->tell()
    $z->seek($position, $whence)
    $z->binmode()
    $z->fileno()
    $z->eof()
    $z->close()

    $RawInflateError ;

    # IO::File mode

    <$z>
    read($z, $buffer);
    read($z, $buffer, $length);
    read($z, $buffer, $length, $offset);
    tell($z)
    seek($z, $position, $whence)
    binmode($z)
    fileno($z)
    eof($z)
    close($z)

=head1 DESCRIPTION

This module provides a Perl interface that allows the reading of
files/buffers that conform to RFC 1951.

For writing RFC 1951 files/buffers, see the companion module IO::Compress::RawDeflate.

=head1 Functional Interface

A top-level function, C<rawinflate>, is provided to carry out
"one-shot" uncompression between buffers and/or files. For finer
control over the uncompression process, see the L</"OO Interface">
section.

    use IO::Uncompress::RawInflate qw(rawinflate $RawInflateError) ;

    rawinflate $input_filename_or_reference => $output_filename_or_reference [,OPTS]
        or die "rawinflate failed: $RawInflateError\n";

The functional interface needs Perl5.005 or better.

=head2 rawinflate $input_filename_or_reference => $output_filename_or_reference [, OPTS]

C<rawinflate> expects at least two parameters,
C<$input_filename_or_reference> and C<$output_filename_or_reference>
and zero or more optional parameters (see L</Optional Parameters>)

=head3 The C<$input_filename_or_reference> parameter

The parameter, C<$input_filename_or_reference>, is used to define the
source of the compressed data.

It can take one of the following forms:

=over 5

=item A filename

If the C<$input_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename. This file will be opened for reading and the
input data will be read from it.

=item A filehandle

If the C<$input_filename_or_reference> parameter is a filehandle, the input
data will be read from it.  The string '-' can be used as an alias for
standard input.

=item A scalar reference

If C<$input_filename_or_reference> is a scalar reference, the input data
will be read from C<$$input_filename_or_reference>.

=item An array reference

If C<$input_filename_or_reference> is an array reference, each element in
the array must be a filename.

The input data will be read from each file in turn.

The complete array will be walked to ensure that it only
contains valid filenames before any data is uncompressed.

=item An Input FileGlob string

If C<$input_filename_or_reference> is a string that is delimited by the
characters "<" and ">" C<rawinflate> will assume that it is an
I<input fileglob string>. The input is the list of files that match the
fileglob.

See L<File::GlobMapper|File::GlobMapper> for more details.

=back

If the C<$input_filename_or_reference> parameter is any other type,
C<undef> will be returned.

=head3 The C<$output_filename_or_reference> parameter

The parameter C<$output_filename_or_reference> is used to control the
destination of the uncompressed data. This parameter can take one of
these forms.

=over 5

=item A filename

If the C<$output_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename.  This file will be opened for writing and the
uncompressed data will be written to it.

=item A filehandle

If the C<$output_filename_or_reference> parameter is a filehandle, the
uncompressed data will be written to it.  The string '-' can be used as
an alias for standard output.

=item A scalar reference

If C<$output_filename_or_reference> is a scalar reference, the
uncompressed data will be stored in C<$$output_filename_or_reference>.

=item An Array Reference

If C<$output_filename_or_reference> is an array reference,
the uncompressed data will be pushed onto the array.

=item An Output FileGlob

If C<$output_filename_or_reference> is a string that is delimited by the
characters "<" and ">" C<rawinflate> will assume that it is an
I<output fileglob string>. The output is the list of files that match the
fileglob.

When C<$output_filename_or_reference> is an fileglob string,
C<$input_filename_or_reference> must also be a fileglob string. Anything
else is an error.

See L<File::GlobMapper|File::GlobMapper> for more details.

=back

If the C<$output_filename_or_reference> parameter is any other type,
C<undef> will be returned.

=head2 Notes

When C<$input_filename_or_reference> maps to multiple compressed
files/buffers and C<$output_filename_or_reference> is
a single file/buffer, after uncompression C<$output_filename_or_reference> will contain a
concatenation of all the uncompressed data from each of the input
files/buffers.

=head2 Optional Parameters

The optional parameters for the one-shot function C<rawinflate>
are (for the most part) identical to those used with the OO interface defined in the
L</"Constructor Options"> section. The exceptions are listed below

=over 5

=item C<< AutoClose => 0|1 >>

This option applies to any input or output data streams to
C<rawinflate> that are filehandles.

If C<AutoClose> is specified, and the value is true, it will result in all
input and/or output filehandles being closed once C<rawinflate> has
completed.

This parameter defaults to 0.

=item C<< BinModeOut => 0|1 >>

This option is now a no-op. All files will be written  in binmode.

=item C<< Append => 0|1 >>

The behaviour of this option is dependent on the type of output data
stream.

=over 5

=item * A Buffer

If C<Append> is enabled, all uncompressed data will be append to the end of
the output buffer. Otherwise the output buffer will be cleared before any
uncompressed data is written to it.

=item * A Filename

If C<Append> is enabled, the file will be opened in append mode. Otherwise
the contents of the file, if any, will be truncated before any uncompressed
data is written to it.

=item * A Filehandle

If C<Append> is enabled, the filehandle will be positioned to the end of
the file via a call to C<seek> before any uncompressed data is
written to it.  Otherwise the file pointer will not be moved.

=back

When C<Append> is specified, and set to true, it will I<append> all uncompressed
data to the output data stream.

So when the output is a filehandle it will carry out a seek to the eof
before writing any uncompressed data. If the output is a filename, it will be opened for
appending. If the output is a buffer, all uncompressed data will be
appended to the existing buffer.

Conversely when C<Append> is not specified, or it is present and is set to
false, it will operate as follows.

When the output is a filename, it will truncate the contents of the file
before writing any uncompressed data. If the output is a filehandle
its position will not be changed. If the output is a buffer, it will be
wiped before any uncompressed data is output.

Defaults to 0.

=item C<< MultiStream => 0|1 >>

This option is a no-op.

=item C<< TrailingData => $scalar >>

Returns the data, if any, that is present immediately after the compressed
data stream once uncompression is complete.

This option can be used when there is useful information immediately
following the compressed data stream, and you don't know the length of the
compressed data stream.

If the input is a buffer, C<trailingData> will return everything from the
end of the compressed data stream to the end of the buffer.

If the input is a filehandle, C<trailingData> will return the data that is
left in the filehandle input buffer once the end of the compressed data
stream has been reached. You can then use the filehandle to read the rest
of the input file.

Don't bother using C<trailingData> if the input is a filename.

If you know the length of the compressed data stream before you start
uncompressing, you can avoid having to use C<trailingData> by setting the
C<InputLength> option.

=back

=head2 Examples

To read the contents of the file C<file1.txt.1951> and write the
uncompressed data to the file C<file1.txt>.

    use strict ;
    use warnings ;
    use IO::Uncompress::RawInflate qw(rawinflate $RawInflateError) ;

    my $input = "file1.txt.1951";
    my $output = "file1.txt";
    rawinflate $input => $output
        or die "rawinflate failed: $RawInflateError\n";

To read from an existing Perl filehandle, C<$input>, and write the
uncompressed data to a buffer, C<$buffer>.

    use strict ;
    use warnings ;
    use IO::Uncompress::RawInflate qw(rawinflate $RawInflateError) ;
    use IO::File ;

    my $input = IO::File->new( "<file1.txt.1951" )
        or die "Cannot open 'file1.txt.1951': $!\n" ;
    my $buffer ;
    rawinflate $input => \$buffer
        or die "rawinflate failed: $RawInflateError\n";

To uncompress all files in the directory "/my/home" that match "*.txt.1951" and store the compressed data in the same directory

    use strict ;
    use warnings ;
    use IO::Uncompress::RawInflate qw(rawinflate $RawInflateError) ;

    rawinflate '</my/home/*.txt.1951>' => '</my/home/#1.txt>'
        or die "rawinflate failed: $RawInflateError\n";

and if you want to compress each file one at a time, this will do the trick

    use strict ;
    use warnings ;
    use IO::Uncompress::RawInflate qw(rawinflate $RawInflateError) ;

    for my $input ( glob "/my/home/*.txt.1951" )
    {
        my $output = $input;
        $output =~ s/.1951// ;
        rawinflate $input => $output
            or die "Error compressing '$input': $RawInflateError\n";
    }

=head1 OO Interface

=head2 Constructor

The format of the constructor for IO::Uncompress::RawInflate is shown below

    my $z = IO::Uncompress::RawInflate->new( $input [OPTS] )
        or die "IO::Uncompress::RawInflate failed: $RawInflateError\n";

Returns an C<IO::Uncompress::RawInflate> object on success and undef on failure.
The variable C<$RawInflateError> will contain an error message on failure.

If you are running Perl 5.005 or better the object, C<$z>, returned from
IO::Uncompress::RawInflate can be used exactly like an L<IO::File|IO::File> filehandle.
This means that all normal input file operations can be carried out with
C<$z>.  For example, to read a line from a compressed file/buffer you can
use either of these forms

    $line = $z->getline();
    $line = <$z>;

The mandatory parameter C<$input> is used to determine the source of the
compressed data. This parameter can take one of three forms.

=over 5

=item A filename

If the C<$input> parameter is a scalar, it is assumed to be a filename. This
file will be opened for reading and the compressed data will be read from it.

=item A filehandle

If the C<$input> parameter is a filehandle, the compressed data will be
read from it.
The string '-' can be used as an alias for standard input.

=item A scalar reference

If C<$input> is a scalar reference, the compressed data will be read from
C<$$input>.

=back

=head2 Constructor Options

The option names defined below are case insensitive and can be optionally
prefixed by a '-'.  So all of the following are valid

    -AutoClose
    -autoclose
    AUTOCLOSE
    autoclose

OPTS is a combination of the following options:

=over 5

=item C<< AutoClose => 0|1 >>

This option is only valid when the C<$input> parameter is a filehandle. If
specified, and the value is true, it will result in the file being closed once
either the C<close> method is called or the IO::Uncompress::RawInflate object is
destroyed.

This parameter defaults to 0.

=item C<< MultiStream => 0|1 >>

Allows multiple concatenated compressed streams to be treated as a single
compressed stream. Decompression will stop once either the end of the
file/buffer is reached, an error is encountered (premature eof, corrupt
compressed data) or the end of a stream is not immediately followed by the
start of another stream.

This parameter defaults to 0.

=item C<< Prime => $string >>

This option will uncompress the contents of C<$string> before processing the
input file/buffer.

This option can be useful when the compressed data is embedded in another
file/data structure and it is not possible to work out where the compressed
data begins without having to read the first few bytes. If this is the
case, the uncompression can be I<primed> with these bytes using this
option.

=item C<< Transparent => 0|1 >>

If this option is set and the input file/buffer is not compressed data,
the module will allow reading of it anyway.

In addition, if the input file/buffer does contain compressed data and
there is non-compressed data immediately following it, setting this option
will make this module treat the whole file/buffer as a single data stream.

This option defaults to 1.

=item C<< BlockSize => $num >>

When reading the compressed input data, IO::Uncompress::RawInflate will read it in
blocks of C<$num> bytes.

This option defaults to 4096.

=item C<< InputLength => $size >>

When present this option will limit the number of compressed bytes read
from the input file/buffer to C<$size>. This option can be used in the
situation where there is useful data directly after the compressed data
stream and you know beforehand the exact length of the compressed data
stream.

This option is mostly used when reading from a filehandle, in which case
the file pointer will be left pointing to the first byte directly after the
compressed data stream.

This option defaults to off.

=item C<< Append => 0|1 >>

This option controls what the C<read> method does with uncompressed data.

If set to 1, all uncompressed data will be appended to the output parameter
of the C<read> method.

If set to 0, the contents of the output parameter of the C<read> method
will be overwritten by the uncompressed data.

Defaults to 0.

=item C<< Strict => 0|1 >>

This option is a no-op.

=back

=head2 Examples

TODO

=head1 Methods

=head2 read

Usage is

    $status = $z->read($buffer)

Reads a block of compressed data (the size of the compressed block is
determined by the C<Buffer> option in the constructor), uncompresses it and
writes any uncompressed data into C<$buffer>. If the C<Append> parameter is
set in the constructor, the uncompressed data will be appended to the
C<$buffer> parameter. Otherwise C<$buffer> will be overwritten.

Returns the number of uncompressed bytes written to C<$buffer>, zero if eof
or a negative number on error.

=head2 read

Usage is

    $status = $z->read($buffer, $length)
    $status = $z->read($buffer, $length, $offset)

    $status = read($z, $buffer, $length)
    $status = read($z, $buffer, $length, $offset)

Attempt to read C<$length> bytes of uncompressed data into C<$buffer>.

The main difference between this form of the C<read> method and the
previous one, is that this one will attempt to return I<exactly> C<$length>
bytes. The only circumstances that this function will not is if end-of-file
or an IO error is encountered.

Returns the number of uncompressed bytes written to C<$buffer>, zero if eof
or a negative number on error.

=head2 getline

Usage is

    $line = $z->getline()
    $line = <$z>

Reads a single line.

This method fully supports the use of the variable C<$/> (or
C<$INPUT_RECORD_SEPARATOR> or C<$RS> when C<English> is in use) to
determine what constitutes an end of line. Paragraph mode, record mode and
file slurp mode are all supported.

=head2 getc

Usage is

    $char = $z->getc()

Read a single character.

=head2 ungetc

Usage is

    $char = $z->ungetc($string)

=head2 inflateSync

Usage is

    $status = $z->inflateSync()

TODO

=head2 getHeaderInfo

Usage is

    $hdr  = $z->getHeaderInfo();
    @hdrs = $z->getHeaderInfo();

This method returns either a hash reference (in scalar context) or a list
or hash references (in array context) that contains information about each
of the header fields in the compressed data stream(s).

=head2 tell

Usage is

    $z->tell()
    tell $z

Returns the uncompressed file offset.

=head2 eof

Usage is

    $z->eof();
    eof($z);

Returns true if the end of the compressed input stream has been reached.

=head2 seek

    $z->seek($position, $whence);
    seek($z, $position, $whence);

Provides a sub-set of the C<seek> functionality, with the restriction
that it is only legal to seek forward in the input file/buffer.
It is a fatal error to attempt to seek backward.

Note that the implementation of C<seek> in this module does not provide
true random access to a compressed file/buffer. It  works by uncompressing
data from the current offset in the file/buffer until it reaches the
uncompressed offset specified in the parameters to C<seek>. For very small
files this may be acceptable behaviour. For large files it may cause an
unacceptable delay.

The C<$whence> parameter takes one the usual values, namely SEEK_SET,
SEEK_CUR or SEEK_END.

Returns 1 on success, 0 on failure.

=head2 binmode

Usage is

    $z->binmode
    binmode $z ;

This is a noop provided for completeness.

=head2 opened

    $z->opened()

Returns true if the object currently refers to a opened file/buffer.

=head2 autoflush

    my $prev = $z->autoflush()
    my $prev = $z->autoflush(EXPR)

If the C<$z> object is associated with a file or a filehandle, this method
returns the current autoflush setting for the underlying filehandle. If
C<EXPR> is present, and is non-zero, it will enable flushing after every
write/print operation.

If C<$z> is associated with a buffer, this method has no effect and always
returns C<undef>.

B<Note> that the special variable C<$|> B<cannot> be used to set or
retrieve the autoflush setting.

=head2 input_line_number

    $z->input_line_number()
    $z->input_line_number(EXPR)

Returns the current uncompressed line number. If C<EXPR> is present it has
the effect of setting the line number. Note that setting the line number
does not change the current position within the file/buffer being read.

The contents of C<$/> are used to determine what constitutes a line
terminator.

=head2 fileno

    $z->fileno()
    fileno($z)

If the C<$z> object is associated with a file or a filehandle, C<fileno>
will return the underlying file descriptor. Once the C<close> method is
called C<fileno> will return C<undef>.

If the C<$z> object is associated with a buffer, this method will return
C<undef>.

=head2 close

    $z->close() ;
    close $z ;

Closes the output file/buffer.

For most versions of Perl this method will be automatically invoked if
the IO::Uncompress::RawInflate object is destroyed (either explicitly or by the
variable with the reference to the object going out of scope). The
exceptions are Perl versions 5.005 through 5.00504 and 5.8.0. In
these cases, the C<close> method will be called automatically, but
not until global destruction of all live objects when the program is
terminating.

Therefore, if you want your scripts to be able to run on all versions
of Perl, you should call C<close> explicitly and not rely on automatic
closing.

Returns true on success, otherwise 0.

If the C<AutoClose> option has been enabled when the IO::Uncompress::RawInflate
object was created, and the object is associated with a file, the
underlying file will also be closed.

=head2 nextStream

Usage is

    my $status = $z->nextStream();

Skips to the next compressed data stream in the input file/buffer. If a new
compressed data stream is found, the eof marker will be cleared and C<$.>
will be reset to 0.

Returns 1 if a new stream was found, 0 if none was found, and -1 if an
error was encountered.

=head2 trailingData

Usage is

    my $data = $z->trailingData();

Returns the data, if any, that is present immediately after the compressed
data stream once uncompression is complete. It only makes sense to call
this method once the end of the compressed data stream has been
encountered.

This option can be used when there is useful information immediately
following the compressed data stream, and you don't know the length of the
compressed data stream.

If the input is a buffer, C<trailingData> will return everything from the
end of the compressed data stream to the end of the buffer.

If the input is a filehandle, C<trailingData> will return the data that is
left in the filehandle input buffer once the end of the compressed data
stream has been reached. You can then use the filehandle to read the rest
of the input file.

Don't bother using C<trailingData> if the input is a filename.

If you know the length of the compressed data stream before you start
uncompressing, you can avoid having to use C<trailingData> by setting the
C<InputLength> option in the constructor.

=head1 Importing

No symbolic constants are required by IO::Uncompress::RawInflate at present.

=over 5

=item :all

Imports C<rawinflate> and C<$RawInflateError>.
Same as doing this

    use IO::Uncompress::RawInflate qw(rawinflate $RawInflateError) ;

=back

=head1 EXAMPLES

=head2 Working with Net::FTP

See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP">

=head1 SUPPORT

General feedback/questions/bug reports should be sent to
L<https://github.com/pmqs/IO-Compress/issues> (preferred) or
L<https://rt.cpan.org/Public/Dist/Display.html?Name=IO-Compress>.

=head1 SEE ALSO

L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzip>, L<IO::Uncompress::UnLzip>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Compress::Zstd>, L<IO::Uncompress::UnZstd>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>

L<IO::Compress::FAQ|IO::Compress::FAQ>

L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>,
L<Archive::Tar|Archive::Tar>,
L<IO::Zlib|IO::Zlib>

For RFC 1950, 1951 and 1952 see
L<http://www.faqs.org/rfcs/rfc1950.html>,
L<http://www.faqs.org/rfcs/rfc1951.html> and
L<http://www.faqs.org/rfcs/rfc1952.html>

The I<zlib> compression library was written by Jean-loup Gailly
C<gzip@prep.ai.mit.edu> and Mark Adler C<madler@alumni.caltech.edu>.

The primary site for the I<zlib> compression library is
L<http://www.zlib.org>.

The primary site for gzip is L<http://www.gzip.org>.

=head1 AUTHOR

This module was written by Paul Marquess, C<pmqs@cpan.org>.

=head1 MODIFICATION HISTORY

See the Changes file.

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2005-2021 Paul Marquess. All rights reserved.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
                                                                                                                                                                                                                                                                                                                                                                                                                               Uncompress/Bunzip2.pm                                                                               0000644                 00000061704 00000000000 0010542 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       package IO::Uncompress::Bunzip2 ;

use strict ;
use warnings;
use bytes;

use IO::Compress::Base::Common 2.101 qw(:Status );

use IO::Uncompress::Base 2.101 ;
use IO::Uncompress::Adapter::Bunzip2 2.101 ;

require Exporter ;
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $Bunzip2Error);

$VERSION = '2.102';
$Bunzip2Error = '';

@ISA    = qw(IO::Uncompress::Base Exporter);
@EXPORT_OK = qw( $Bunzip2Error bunzip2 ) ;
#%EXPORT_TAGS = %IO::Uncompress::Base::EXPORT_TAGS ;
push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
#Exporter::export_ok_tags('all');


sub new
{
    my $class = shift ;
    my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$Bunzip2Error);

    $obj->_create(undef, 0, @_);
}

sub bunzip2
{
    my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$Bunzip2Error);
    return $obj->_inf(@_);
}

sub getExtraParams
{
    return (
            'verbosity'     => [IO::Compress::Base::Common::Parse_boolean,   0],
            'small'         => [IO::Compress::Base::Common::Parse_boolean,   0],
        );
}


sub ckParams
{
    my $self = shift ;
    my $got = shift ;

    return 1;
}

sub mkUncomp
{
    my $self = shift ;
    my $got = shift ;

     my $magic = $self->ckMagic()
        or return 0;

    *$self->{Info} = $self->readHeader($magic)
        or return undef ;

    my $Small     = $got->getValue('small');
    my $Verbosity = $got->getValue('verbosity');

    my ($obj, $errstr, $errno) =  IO::Uncompress::Adapter::Bunzip2::mkUncompObject(
                                                    $Small, $Verbosity);

    return $self->saveErrorString(undef, $errstr, $errno)
        if ! defined $obj;

    *$self->{Uncomp} = $obj;

    return 1;

}


sub ckMagic
{
    my $self = shift;

    my $magic ;
    $self->smartReadExact(\$magic, 4);

    *$self->{HeaderPending} = $magic ;

    return $self->HeaderError("Header size is " .
                                        4 . " bytes")
        if length $magic != 4;

    return $self->HeaderError("Bad Magic.")
        if ! isBzip2Magic($magic) ;


    *$self->{Type} = 'bzip2';
    return $magic;
}

sub readHeader
{
    my $self = shift;
    my $magic = shift ;

    $self->pushBack($magic);
    *$self->{HeaderPending} = '';


    return {
        'Type'              => 'bzip2',
        'FingerprintLength' => 4,
        'HeaderLength'      => 4,
        'TrailerLength'     => 0,
        'Header'            => '$magic'
        };

}

sub chkTrailer
{
    return STATUS_OK;
}



sub isBzip2Magic
{
    my $buffer = shift ;
    return $buffer =~ /^BZh\d$/;
}

1 ;

__END__


=head1 NAME

IO::Uncompress::Bunzip2 - Read bzip2 files/buffers

=head1 SYNOPSIS

    use IO::Uncompress::Bunzip2 qw(bunzip2 $Bunzip2Error) ;

    my $status = bunzip2 $input => $output [,OPTS]
        or die "bunzip2 failed: $Bunzip2Error\n";

    my $z = IO::Uncompress::Bunzip2->new( $input [OPTS] )
        or die "bunzip2 failed: $Bunzip2Error\n";

    $status = $z->read($buffer)
    $status = $z->read($buffer, $length)
    $status = $z->read($buffer, $length, $offset)
    $line = $z->getline()
    $char = $z->getc()
    $char = $z->ungetc()
    $char = $z->opened()

    $data = $z->trailingData()
    $status = $z->nextStream()
    $data = $z->getHeaderInfo()
    $z->tell()
    $z->seek($position, $whence)
    $z->binmode()
    $z->fileno()
    $z->eof()
    $z->close()

    $Bunzip2Error ;

    # IO::File mode

    <$z>
    read($z, $buffer);
    read($z, $buffer, $length);
    read($z, $buffer, $length, $offset);
    tell($z)
    seek($z, $position, $whence)
    binmode($z)
    fileno($z)
    eof($z)
    close($z)

=head1 DESCRIPTION

This module provides a Perl interface that allows the reading of
bzip2 files/buffers.

For writing bzip2 files/buffers, see the companion module IO::Compress::Bzip2.

=head1 Functional Interface

A top-level function, C<bunzip2>, is provided to carry out
"one-shot" uncompression between buffers and/or files. For finer
control over the uncompression process, see the L</"OO Interface">
section.

    use IO::Uncompress::Bunzip2 qw(bunzip2 $Bunzip2Error) ;

    bunzip2 $input_filename_or_reference => $output_filename_or_reference [,OPTS]
        or die "bunzip2 failed: $Bunzip2Error\n";

The functional interface needs Perl5.005 or better.

=head2 bunzip2 $input_filename_or_reference => $output_filename_or_reference [, OPTS]

C<bunzip2> expects at least two parameters,
C<$input_filename_or_reference> and C<$output_filename_or_reference>
and zero or more optional parameters (see L</Optional Parameters>)

=head3 The C<$input_filename_or_reference> parameter

The parameter, C<$input_filename_or_reference>, is used to define the
source of the compressed data.

It can take one of the following forms:

=over 5

=item A filename

If the C<$input_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename. This file will be opened for reading and the
input data will be read from it.

=item A filehandle

If the C<$input_filename_or_reference> parameter is a filehandle, the input
data will be read from it.  The string '-' can be used as an alias for
standard input.

=item A scalar reference

If C<$input_filename_or_reference> is a scalar reference, the input data
will be read from C<$$input_filename_or_reference>.

=item An array reference

If C<$input_filename_or_reference> is an array reference, each element in
the array must be a filename.

The input data will be read from each file in turn.

The complete array will be walked to ensure that it only
contains valid filenames before any data is uncompressed.

=item An Input FileGlob string

If C<$input_filename_or_reference> is a string that is delimited by the
characters "<" and ">" C<bunzip2> will assume that it is an
I<input fileglob string>. The input is the list of files that match the
fileglob.

See L<File::GlobMapper|File::GlobMapper> for more details.

=back

If the C<$input_filename_or_reference> parameter is any other type,
C<undef> will be returned.

=head3 The C<$output_filename_or_reference> parameter

The parameter C<$output_filename_or_reference> is used to control the
destination of the uncompressed data. This parameter can take one of
these forms.

=over 5

=item A filename

If the C<$output_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename.  This file will be opened for writing and the
uncompressed data will be written to it.

=item A filehandle

If the C<$output_filename_or_reference> parameter is a filehandle, the
uncompressed data will be written to it.  The string '-' can be used as
an alias for standard output.

=item A scalar reference

If C<$output_filename_or_reference> is a scalar reference, the
uncompressed data will be stored in C<$$output_filename_or_reference>.

=item An Array Reference

If C<$output_filename_or_reference> is an array reference,
the uncompressed data will be pushed onto the array.

=item An Output FileGlob

If C<$output_filename_or_reference> is a string that is delimited by the
characters "<" and ">" C<bunzip2> will assume that it is an
I<output fileglob string>. The output is the list of files that match the
fileglob.

When C<$output_filename_or_reference> is an fileglob string,
C<$input_filename_or_reference> must also be a fileglob string. Anything
else is an error.

See L<File::GlobMapper|File::GlobMapper> for more details.

=back

If the C<$output_filename_or_reference> parameter is any other type,
C<undef> will be returned.

=head2 Notes

When C<$input_filename_or_reference> maps to multiple compressed
files/buffers and C<$output_filename_or_reference> is
a single file/buffer, after uncompression C<$output_filename_or_reference> will contain a
concatenation of all the uncompressed data from each of the input
files/buffers.

=head2 Optional Parameters

The optional parameters for the one-shot function C<bunzip2>
are (for the most part) identical to those used with the OO interface defined in the
L</"Constructor Options"> section. The exceptions are listed below

=over 5

=item C<< AutoClose => 0|1 >>

This option applies to any input or output data streams to
C<bunzip2> that are filehandles.

If C<AutoClose> is specified, and the value is true, it will result in all
input and/or output filehandles being closed once C<bunzip2> has
completed.

This parameter defaults to 0.

=item C<< BinModeOut => 0|1 >>

This option is now a no-op. All files will be written  in binmode.

=item C<< Append => 0|1 >>

The behaviour of this option is dependent on the type of output data
stream.

=over 5

=item * A Buffer

If C<Append> is enabled, all uncompressed data will be append to the end of
the output buffer. Otherwise the output buffer will be cleared before any
uncompressed data is written to it.

=item * A Filename

If C<Append> is enabled, the file will be opened in append mode. Otherwise
the contents of the file, if any, will be truncated before any uncompressed
data is written to it.

=item * A Filehandle

If C<Append> is enabled, the filehandle will be positioned to the end of
the file via a call to C<seek> before any uncompressed data is
written to it.  Otherwise the file pointer will not be moved.

=back

When C<Append> is specified, and set to true, it will I<append> all uncompressed
data to the output data stream.

So when the output is a filehandle it will carry out a seek to the eof
before writing any uncompressed data. If the output is a filename, it will be opened for
appending. If the output is a buffer, all uncompressed data will be
appended to the existing buffer.

Conversely when C<Append> is not specified, or it is present and is set to
false, it will operate as follows.

When the output is a filename, it will truncate the contents of the file
before writing any uncompressed data. If the output is a filehandle
its position will not be changed. If the output is a buffer, it will be
wiped before any uncompressed data is output.

Defaults to 0.

=item C<< MultiStream => 0|1 >>

If the input file/buffer contains multiple compressed data streams, this
option will uncompress the whole lot as a single data stream.

Defaults to 0.

=item C<< TrailingData => $scalar >>

Returns the data, if any, that is present immediately after the compressed
data stream once uncompression is complete.

This option can be used when there is useful information immediately
following the compressed data stream, and you don't know the length of the
compressed data stream.

If the input is a buffer, C<trailingData> will return everything from the
end of the compressed data stream to the end of the buffer.

If the input is a filehandle, C<trailingData> will return the data that is
left in the filehandle input buffer once the end of the compressed data
stream has been reached. You can then use the filehandle to read the rest
of the input file.

Don't bother using C<trailingData> if the input is a filename.

If you know the length of the compressed data stream before you start
uncompressing, you can avoid having to use C<trailingData> by setting the
C<InputLength> option.

=back

=head2 Examples

To read the contents of the file C<file1.txt.bz2> and write the
uncompressed data to the file C<file1.txt>.

    use strict ;
    use warnings ;
    use IO::Uncompress::Bunzip2 qw(bunzip2 $Bunzip2Error) ;

    my $input = "file1.txt.bz2";
    my $output = "file1.txt";
    bunzip2 $input => $output
        or die "bunzip2 failed: $Bunzip2Error\n";

To read from an existing Perl filehandle, C<$input>, and write the
uncompressed data to a buffer, C<$buffer>.

    use strict ;
    use warnings ;
    use IO::Uncompress::Bunzip2 qw(bunzip2 $Bunzip2Error) ;
    use IO::File ;

    my $input = IO::File->new( "<file1.txt.bz2" )
        or die "Cannot open 'file1.txt.bz2': $!\n" ;
    my $buffer ;
    bunzip2 $input => \$buffer
        or die "bunzip2 failed: $Bunzip2Error\n";

To uncompress all files in the directory "/my/home" that match "*.txt.bz2" and store the compressed data in the same directory

    use strict ;
    use warnings ;
    use IO::Uncompress::Bunzip2 qw(bunzip2 $Bunzip2Error) ;

    bunzip2 '</my/home/*.txt.bz2>' => '</my/home/#1.txt>'
        or die "bunzip2 failed: $Bunzip2Error\n";

and if you want to compress each file one at a time, this will do the trick

    use strict ;
    use warnings ;
    use IO::Uncompress::Bunzip2 qw(bunzip2 $Bunzip2Error) ;

    for my $input ( glob "/my/home/*.txt.bz2" )
    {
        my $output = $input;
        $output =~ s/.bz2// ;
        bunzip2 $input => $output
            or die "Error compressing '$input': $Bunzip2Error\n";
    }

=head1 OO Interface

=head2 Constructor

The format of the constructor for IO::Uncompress::Bunzip2 is shown below

    my $z = IO::Uncompress::Bunzip2->new( $input [OPTS] )
        or die "IO::Uncompress::Bunzip2 failed: $Bunzip2Error\n";

Returns an C<IO::Uncompress::Bunzip2> object on success and undef on failure.
The variable C<$Bunzip2Error> will contain an error message on failure.

If you are running Perl 5.005 or better the object, C<$z>, returned from
IO::Uncompress::Bunzip2 can be used exactly like an L<IO::File|IO::File> filehandle.
This means that all normal input file operations can be carried out with
C<$z>.  For example, to read a line from a compressed file/buffer you can
use either of these forms

    $line = $z->getline();
    $line = <$z>;

The mandatory parameter C<$input> is used to determine the source of the
compressed data. This parameter can take one of three forms.

=over 5

=item A filename

If the C<$input> parameter is a scalar, it is assumed to be a filename. This
file will be opened for reading and the compressed data will be read from it.

=item A filehandle

If the C<$input> parameter is a filehandle, the compressed data will be
read from it.
The string '-' can be used as an alias for standard input.

=item A scalar reference

If C<$input> is a scalar reference, the compressed data will be read from
C<$$input>.

=back

=head2 Constructor Options

The option names defined below are case insensitive and can be optionally
prefixed by a '-'.  So all of the following are valid

    -AutoClose
    -autoclose
    AUTOCLOSE
    autoclose

OPTS is a combination of the following options:

=over 5

=item C<< AutoClose => 0|1 >>

This option is only valid when the C<$input> parameter is a filehandle. If
specified, and the value is true, it will result in the file being closed once
either the C<close> method is called or the IO::Uncompress::Bunzip2 object is
destroyed.

This parameter defaults to 0.

=item C<< MultiStream => 0|1 >>

Allows multiple concatenated compressed streams to be treated as a single
compressed stream. Decompression will stop once either the end of the
file/buffer is reached, an error is encountered (premature eof, corrupt
compressed data) or the end of a stream is not immediately followed by the
start of another stream.

This parameter defaults to 0.

=item C<< Prime => $string >>

This option will uncompress the contents of C<$string> before processing the
input file/buffer.

This option can be useful when the compressed data is embedded in another
file/data structure and it is not possible to work out where the compressed
data begins without having to read the first few bytes. If this is the
case, the uncompression can be I<primed> with these bytes using this
option.

=item C<< Transparent => 0|1 >>

If this option is set and the input file/buffer is not compressed data,
the module will allow reading of it anyway.

In addition, if the input file/buffer does contain compressed data and
there is non-compressed data immediately following it, setting this option
will make this module treat the whole file/buffer as a single data stream.

This option defaults to 1.

=item C<< BlockSize => $num >>

When reading the compressed input data, IO::Uncompress::Bunzip2 will read it in
blocks of C<$num> bytes.

This option defaults to 4096.

=item C<< InputLength => $size >>

When present this option will limit the number of compressed bytes read
from the input file/buffer to C<$size>. This option can be used in the
situation where there is useful data directly after the compressed data
stream and you know beforehand the exact length of the compressed data
stream.

This option is mostly used when reading from a filehandle, in which case
the file pointer will be left pointing to the first byte directly after the
compressed data stream.

This option defaults to off.

=item C<< Append => 0|1 >>

This option controls what the C<read> method does with uncompressed data.

If set to 1, all uncompressed data will be appended to the output parameter
of the C<read> method.

If set to 0, the contents of the output parameter of the C<read> method
will be overwritten by the uncompressed data.

Defaults to 0.

=item C<< Strict => 0|1 >>

This option is a no-op.

=item C<< Small => 0|1 >>

When non-zero this options will make bzip2 use a decompression algorithm
that uses less memory at the expense of increasing the amount of time
taken for decompression.

Default is 0.

=back

=head2 Examples

TODO

=head1 Methods

=head2 read

Usage is

    $status = $z->read($buffer)

Reads a block of compressed data (the size of the compressed block is
determined by the C<Buffer> option in the constructor), uncompresses it and
writes any uncompressed data into C<$buffer>. If the C<Append> parameter is
set in the constructor, the uncompressed data will be appended to the
C<$buffer> parameter. Otherwise C<$buffer> will be overwritten.

Returns the number of uncompressed bytes written to C<$buffer>, zero if eof
or a negative number on error.

=head2 read

Usage is

    $status = $z->read($buffer, $length)
    $status = $z->read($buffer, $length, $offset)

    $status = read($z, $buffer, $length)
    $status = read($z, $buffer, $length, $offset)

Attempt to read C<$length> bytes of uncompressed data into C<$buffer>.

The main difference between this form of the C<read> method and the
previous one, is that this one will attempt to return I<exactly> C<$length>
bytes. The only circumstances that this function will not is if end-of-file
or an IO error is encountered.

Returns the number of uncompressed bytes written to C<$buffer>, zero if eof
or a negative number on error.

=head2 getline

Usage is

    $line = $z->getline()
    $line = <$z>

Reads a single line.

This method fully supports the use of the variable C<$/> (or
C<$INPUT_RECORD_SEPARATOR> or C<$RS> when C<English> is in use) to
determine what constitutes an end of line. Paragraph mode, record mode and
file slurp mode are all supported.

=head2 getc

Usage is

    $char = $z->getc()

Read a single character.

=head2 ungetc

Usage is

    $char = $z->ungetc($string)

=head2 getHeaderInfo

Usage is

    $hdr  = $z->getHeaderInfo();
    @hdrs = $z->getHeaderInfo();

This method returns either a hash reference (in scalar context) or a list
or hash references (in array context) that contains information about each
of the header fields in the compressed data stream(s).

=head2 tell

Usage is

    $z->tell()
    tell $z

Returns the uncompressed file offset.

=head2 eof

Usage is

    $z->eof();
    eof($z);

Returns true if the end of the compressed input stream has been reached.

=head2 seek

    $z->seek($position, $whence);
    seek($z, $position, $whence);

Provides a sub-set of the C<seek> functionality, with the restriction
that it is only legal to seek forward in the input file/buffer.
It is a fatal error to attempt to seek backward.

Note that the implementation of C<seek> in this module does not provide
true random access to a compressed file/buffer. It  works by uncompressing
data from the current offset in the file/buffer until it reaches the
uncompressed offset specified in the parameters to C<seek>. For very small
files this may be acceptable behaviour. For large files it may cause an
unacceptable delay.

The C<$whence> parameter takes one the usual values, namely SEEK_SET,
SEEK_CUR or SEEK_END.

Returns 1 on success, 0 on failure.

=head2 binmode

Usage is

    $z->binmode
    binmode $z ;

This is a noop provided for completeness.

=head2 opened

    $z->opened()

Returns true if the object currently refers to a opened file/buffer.

=head2 autoflush

    my $prev = $z->autoflush()
    my $prev = $z->autoflush(EXPR)

If the C<$z> object is associated with a file or a filehandle, this method
returns the current autoflush setting for the underlying filehandle. If
C<EXPR> is present, and is non-zero, it will enable flushing after every
write/print operation.

If C<$z> is associated with a buffer, this method has no effect and always
returns C<undef>.

B<Note> that the special variable C<$|> B<cannot> be used to set or
retrieve the autoflush setting.

=head2 input_line_number

    $z->input_line_number()
    $z->input_line_number(EXPR)

Returns the current uncompressed line number. If C<EXPR> is present it has
the effect of setting the line number. Note that setting the line number
does not change the current position within the file/buffer being read.

The contents of C<$/> are used to determine what constitutes a line
terminator.

=head2 fileno

    $z->fileno()
    fileno($z)

If the C<$z> object is associated with a file or a filehandle, C<fileno>
will return the underlying file descriptor. Once the C<close> method is
called C<fileno> will return C<undef>.

If the C<$z> object is associated with a buffer, this method will return
C<undef>.

=head2 close

    $z->close() ;
    close $z ;

Closes the output file/buffer.

For most versions of Perl this method will be automatically invoked if
the IO::Uncompress::Bunzip2 object is destroyed (either explicitly or by the
variable with the reference to the object going out of scope). The
exceptions are Perl versions 5.005 through 5.00504 and 5.8.0. In
these cases, the C<close> method will be called automatically, but
not until global destruction of all live objects when the program is
terminating.

Therefore, if you want your scripts to be able to run on all versions
of Perl, you should call C<close> explicitly and not rely on automatic
closing.

Returns true on success, otherwise 0.

If the C<AutoClose> option has been enabled when the IO::Uncompress::Bunzip2
object was created, and the object is associated with a file, the
underlying file will also be closed.

=head2 nextStream

Usage is

    my $status = $z->nextStream();

Skips to the next compressed data stream in the input file/buffer. If a new
compressed data stream is found, the eof marker will be cleared and C<$.>
will be reset to 0.

Returns 1 if a new stream was found, 0 if none was found, and -1 if an
error was encountered.

=head2 trailingData

Usage is

    my $data = $z->trailingData();

Returns the data, if any, that is present immediately after the compressed
data stream once uncompression is complete. It only makes sense to call
this method once the end of the compressed data stream has been
encountered.

This option can be used when there is useful information immediately
following the compressed data stream, and you don't know the length of the
compressed data stream.

If the input is a buffer, C<trailingData> will return everything from the
end of the compressed data stream to the end of the buffer.

If the input is a filehandle, C<trailingData> will return the data that is
left in the filehandle input buffer once the end of the compressed data
stream has been reached. You can then use the filehandle to read the rest
of the input file.

Don't bother using C<trailingData> if the input is a filename.

If you know the length of the compressed data stream before you start
uncompressing, you can avoid having to use C<trailingData> by setting the
C<InputLength> option in the constructor.

=head1 Importing

No symbolic constants are required by IO::Uncompress::Bunzip2 at present.

=over 5

=item :all

Imports C<bunzip2> and C<$Bunzip2Error>.
Same as doing this

    use IO::Uncompress::Bunzip2 qw(bunzip2 $Bunzip2Error) ;

=back

=head1 EXAMPLES

=head2 Working with Net::FTP

See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP">

=head1 SUPPORT

General feedback/questions/bug reports should be sent to
L<https://github.com/pmqs/IO-Compress/issues> (preferred) or
L<https://rt.cpan.org/Public/Dist/Display.html?Name=IO-Compress>.

=head1 SEE ALSO

L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzip>, L<IO::Uncompress::UnLzip>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Compress::Zstd>, L<IO::Uncompress::UnZstd>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>

L<IO::Compress::FAQ|IO::Compress::FAQ>

L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>,
L<Archive::Tar|Archive::Tar>,
L<IO::Zlib|IO::Zlib>

The primary site for the bzip2 program is L<https://sourceware.org/bzip2/>.

See the module L<Compress::Bzip2|Compress::Bzip2>

=head1 AUTHOR

This module was written by Paul Marquess, C<pmqs@cpan.org>.

=head1 MODIFICATION HISTORY

See the Changes file.

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2005-2021 Paul Marquess. All rights reserved.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
                                                            Uncompress/AnyInflate.pm                                                                            0000644                 00000067152 00000000000 0011246 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       package IO::Uncompress::AnyInflate ;

# for RFC1950, RFC1951 or RFC1952

use strict;
use warnings;
use bytes;

use IO::Compress::Base::Common  2.101 qw(:Parse);

use IO::Uncompress::Adapter::Inflate  2.101 ();


use IO::Uncompress::Base  2.101 ;
use IO::Uncompress::Gunzip  2.101 ;
use IO::Uncompress::Inflate  2.101 ;
use IO::Uncompress::RawInflate  2.101 ;
use IO::Uncompress::Unzip  2.101 ;

require Exporter ;

our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $AnyInflateError);

$VERSION = '2.102';
$AnyInflateError = '';

@ISA = qw(IO::Uncompress::Base Exporter);
@EXPORT_OK = qw( $AnyInflateError anyinflate ) ;
%EXPORT_TAGS = %IO::Uncompress::Base::DEFLATE_CONSTANTS if keys %IO::Uncompress::Base::DEFLATE_CONSTANTS;
push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
Exporter::export_ok_tags('all');

# TODO - allow the user to pick a set of the three formats to allow
#        or just assume want to auto-detect any of the three formats.

sub new
{
    my $class = shift ;
    my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$AnyInflateError);
    $obj->_create(undef, 0, @_);
}

sub anyinflate
{
    my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$AnyInflateError);
    return $obj->_inf(@_) ;
}

sub getExtraParams
{
    return ( 'rawinflate' => [Parse_boolean,  0] ) ;
}

sub ckParams
{
    my $self = shift ;
    my $got = shift ;

    # any always needs both crc32 and adler32
    $got->setValue('crc32' => 1);
    $got->setValue('adler32' => 1);

    return 1;
}

sub mkUncomp
{
    my $self = shift ;
    my $got = shift ;

    my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::Inflate::mkUncompObject();

    return $self->saveErrorString(undef, $errstr, $errno)
        if ! defined $obj;

    *$self->{Uncomp} = $obj;

     my @possible = qw( Inflate Gunzip Unzip );
     unshift @possible, 'RawInflate'
        if 1 || $got->getValue('rawinflate');

     my $magic = $self->ckMagic( @possible );

     if ($magic) {
        *$self->{Info} = $self->readHeader($magic)
            or return undef ;

        return 1;
     }

     return 0 ;
}



sub ckMagic
{
    my $self = shift;
    my @names = @_ ;

    my $keep = ref $self ;
    for my $class ( map { "IO::Uncompress::$_" } @names)
    {
        bless $self => $class;
        my $magic = $self->ckMagic();

        if ($magic)
        {
            #bless $self => $class;
            return $magic ;
        }

        $self->pushBack(*$self->{HeaderPending})  ;
        *$self->{HeaderPending} = ''  ;
    }

    bless $self => $keep;
    return undef;
}

1 ;

__END__


=head1 NAME

IO::Uncompress::AnyInflate - Uncompress zlib-based (zip, gzip) file/buffer

=head1 SYNOPSIS

    use IO::Uncompress::AnyInflate qw(anyinflate $AnyInflateError) ;

    my $status = anyinflate $input => $output [,OPTS]
        or die "anyinflate failed: $AnyInflateError\n";

    my $z = IO::Uncompress::AnyInflate->new( $input [OPTS] )
        or die "anyinflate failed: $AnyInflateError\n";

    $status = $z->read($buffer)
    $status = $z->read($buffer, $length)
    $status = $z->read($buffer, $length, $offset)
    $line = $z->getline()
    $char = $z->getc()
    $char = $z->ungetc()
    $char = $z->opened()

    $status = $z->inflateSync()

    $data = $z->trailingData()
    $status = $z->nextStream()
    $data = $z->getHeaderInfo()
    $z->tell()
    $z->seek($position, $whence)
    $z->binmode()
    $z->fileno()
    $z->eof()
    $z->close()

    $AnyInflateError ;

    # IO::File mode

    <$z>
    read($z, $buffer);
    read($z, $buffer, $length);
    read($z, $buffer, $length, $offset);
    tell($z)
    seek($z, $position, $whence)
    binmode($z)
    fileno($z)
    eof($z)
    close($z)

=head1 DESCRIPTION

This module provides a Perl interface that allows the reading of
files/buffers that have been compressed in a number of formats that use the
zlib compression library.

The formats supported are

=over 5

=item RFC 1950

=item RFC 1951 (optionally)

=item gzip (RFC 1952)

=item zip

=back

The module will auto-detect which, if any, of the supported
compression formats is being used.

=head1 Functional Interface

A top-level function, C<anyinflate>, is provided to carry out
"one-shot" uncompression between buffers and/or files. For finer
control over the uncompression process, see the L</"OO Interface">
section.

    use IO::Uncompress::AnyInflate qw(anyinflate $AnyInflateError) ;

    anyinflate $input_filename_or_reference => $output_filename_or_reference [,OPTS]
        or die "anyinflate failed: $AnyInflateError\n";

The functional interface needs Perl5.005 or better.

=head2 anyinflate $input_filename_or_reference => $output_filename_or_reference [, OPTS]

C<anyinflate> expects at least two parameters,
C<$input_filename_or_reference> and C<$output_filename_or_reference>
and zero or more optional parameters (see L</Optional Parameters>)

=head3 The C<$input_filename_or_reference> parameter

The parameter, C<$input_filename_or_reference>, is used to define the
source of the compressed data.

It can take one of the following forms:

=over 5

=item A filename

If the C<$input_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename. This file will be opened for reading and the
input data will be read from it.

=item A filehandle

If the C<$input_filename_or_reference> parameter is a filehandle, the input
data will be read from it.  The string '-' can be used as an alias for
standard input.

=item A scalar reference

If C<$input_filename_or_reference> is a scalar reference, the input data
will be read from C<$$input_filename_or_reference>.

=item An array reference

If C<$input_filename_or_reference> is an array reference, each element in
the array must be a filename.

The input data will be read from each file in turn.

The complete array will be walked to ensure that it only
contains valid filenames before any data is uncompressed.

=item An Input FileGlob string

If C<$input_filename_or_reference> is a string that is delimited by the
characters "<" and ">" C<anyinflate> will assume that it is an
I<input fileglob string>. The input is the list of files that match the
fileglob.

See L<File::GlobMapper|File::GlobMapper> for more details.

=back

If the C<$input_filename_or_reference> parameter is any other type,
C<undef> will be returned.

=head3 The C<$output_filename_or_reference> parameter

The parameter C<$output_filename_or_reference> is used to control the
destination of the uncompressed data. This parameter can take one of
these forms.

=over 5

=item A filename

If the C<$output_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename.  This file will be opened for writing and the
uncompressed data will be written to it.

=item A filehandle

If the C<$output_filename_or_reference> parameter is a filehandle, the
uncompressed data will be written to it.  The string '-' can be used as
an alias for standard output.

=item A scalar reference

If C<$output_filename_or_reference> is a scalar reference, the
uncompressed data will be stored in C<$$output_filename_or_reference>.

=item An Array Reference

If C<$output_filename_or_reference> is an array reference,
the uncompressed data will be pushed onto the array.

=item An Output FileGlob

If C<$output_filename_or_reference> is a string that is delimited by the
characters "<" and ">" C<anyinflate> will assume that it is an
I<output fileglob string>. The output is the list of files that match the
fileglob.

When C<$output_filename_or_reference> is an fileglob string,
C<$input_filename_or_reference> must also be a fileglob string. Anything
else is an error.

See L<File::GlobMapper|File::GlobMapper> for more details.

=back

If the C<$output_filename_or_reference> parameter is any other type,
C<undef> will be returned.

=head2 Notes

When C<$input_filename_or_reference> maps to multiple compressed
files/buffers and C<$output_filename_or_reference> is
a single file/buffer, after uncompression C<$output_filename_or_reference> will contain a
concatenation of all the uncompressed data from each of the input
files/buffers.

=head2 Optional Parameters

The optional parameters for the one-shot function C<anyinflate>
are (for the most part) identical to those used with the OO interface defined in the
L</"Constructor Options"> section. The exceptions are listed below

=over 5

=item C<< AutoClose => 0|1 >>

This option applies to any input or output data streams to
C<anyinflate> that are filehandles.

If C<AutoClose> is specified, and the value is true, it will result in all
input and/or output filehandles being closed once C<anyinflate> has
completed.

This parameter defaults to 0.

=item C<< BinModeOut => 0|1 >>

This option is now a no-op. All files will be written  in binmode.

=item C<< Append => 0|1 >>

The behaviour of this option is dependent on the type of output data
stream.

=over 5

=item * A Buffer

If C<Append> is enabled, all uncompressed data will be append to the end of
the output buffer. Otherwise the output buffer will be cleared before any
uncompressed data is written to it.

=item * A Filename

If C<Append> is enabled, the file will be opened in append mode. Otherwise
the contents of the file, if any, will be truncated before any uncompressed
data is written to it.

=item * A Filehandle

If C<Append> is enabled, the filehandle will be positioned to the end of
the file via a call to C<seek> before any uncompressed data is
written to it.  Otherwise the file pointer will not be moved.

=back

When C<Append> is specified, and set to true, it will I<append> all uncompressed
data to the output data stream.

So when the output is a filehandle it will carry out a seek to the eof
before writing any uncompressed data. If the output is a filename, it will be opened for
appending. If the output is a buffer, all uncompressed data will be
appended to the existing buffer.

Conversely when C<Append> is not specified, or it is present and is set to
false, it will operate as follows.

When the output is a filename, it will truncate the contents of the file
before writing any uncompressed data. If the output is a filehandle
its position will not be changed. If the output is a buffer, it will be
wiped before any uncompressed data is output.

Defaults to 0.

=item C<< MultiStream => 0|1 >>

If the input file/buffer contains multiple compressed data streams, this
option will uncompress the whole lot as a single data stream.

Defaults to 0.

=item C<< TrailingData => $scalar >>

Returns the data, if any, that is present immediately after the compressed
data stream once uncompression is complete.

This option can be used when there is useful information immediately
following the compressed data stream, and you don't know the length of the
compressed data stream.

If the input is a buffer, C<trailingData> will return everything from the
end of the compressed data stream to the end of the buffer.

If the input is a filehandle, C<trailingData> will return the data that is
left in the filehandle input buffer once the end of the compressed data
stream has been reached. You can then use the filehandle to read the rest
of the input file.

Don't bother using C<trailingData> if the input is a filename.

If you know the length of the compressed data stream before you start
uncompressing, you can avoid having to use C<trailingData> by setting the
C<InputLength> option.

=back

=head2 Examples

To read the contents of the file C<file1.txt.Compressed> and write the
uncompressed data to the file C<file1.txt>.

    use strict ;
    use warnings ;
    use IO::Uncompress::AnyInflate qw(anyinflate $AnyInflateError) ;

    my $input = "file1.txt.Compressed";
    my $output = "file1.txt";
    anyinflate $input => $output
        or die "anyinflate failed: $AnyInflateError\n";

To read from an existing Perl filehandle, C<$input>, and write the
uncompressed data to a buffer, C<$buffer>.

    use strict ;
    use warnings ;
    use IO::Uncompress::AnyInflate qw(anyinflate $AnyInflateError) ;
    use IO::File ;

    my $input = IO::File->new( "<file1.txt.Compressed" )
        or die "Cannot open 'file1.txt.Compressed': $!\n" ;
    my $buffer ;
    anyinflate $input => \$buffer
        or die "anyinflate failed: $AnyInflateError\n";

To uncompress all files in the directory "/my/home" that match "*.txt.Compressed" and store the compressed data in the same directory

    use strict ;
    use warnings ;
    use IO::Uncompress::AnyInflate qw(anyinflate $AnyInflateError) ;

    anyinflate '</my/home/*.txt.Compressed>' => '</my/home/#1.txt>'
        or die "anyinflate failed: $AnyInflateError\n";

and if you want to compress each file one at a time, this will do the trick

    use strict ;
    use warnings ;
    use IO::Uncompress::AnyInflate qw(anyinflate $AnyInflateError) ;

    for my $input ( glob "/my/home/*.txt.Compressed" )
    {
        my $output = $input;
        $output =~ s/.Compressed// ;
        anyinflate $input => $output
            or die "Error compressing '$input': $AnyInflateError\n";
    }

=head1 OO Interface

=head2 Constructor

The format of the constructor for IO::Uncompress::AnyInflate is shown below

    my $z = IO::Uncompress::AnyInflate->new( $input [OPTS] )
        or die "IO::Uncompress::AnyInflate failed: $AnyInflateError\n";

Returns an C<IO::Uncompress::AnyInflate> object on success and undef on failure.
The variable C<$AnyInflateError> will contain an error message on failure.

If you are running Perl 5.005 or better the object, C<$z>, returned from
IO::Uncompress::AnyInflate can be used exactly like an L<IO::File|IO::File> filehandle.
This means that all normal input file operations can be carried out with
C<$z>.  For example, to read a line from a compressed file/buffer you can
use either of these forms

    $line = $z->getline();
    $line = <$z>;

The mandatory parameter C<$input> is used to determine the source of the
compressed data. This parameter can take one of three forms.

=over 5

=item A filename

If the C<$input> parameter is a scalar, it is assumed to be a filename. This
file will be opened for reading and the compressed data will be read from it.

=item A filehandle

If the C<$input> parameter is a filehandle, the compressed data will be
read from it.
The string '-' can be used as an alias for standard input.

=item A scalar reference

If C<$input> is a scalar reference, the compressed data will be read from
C<$$input>.

=back

=head2 Constructor Options

The option names defined below are case insensitive and can be optionally
prefixed by a '-'.  So all of the following are valid

    -AutoClose
    -autoclose
    AUTOCLOSE
    autoclose

OPTS is a combination of the following options:

=over 5

=item C<< AutoClose => 0|1 >>

This option is only valid when the C<$input> parameter is a filehandle. If
specified, and the value is true, it will result in the file being closed once
either the C<close> method is called or the IO::Uncompress::AnyInflate object is
destroyed.

This parameter defaults to 0.

=item C<< MultiStream => 0|1 >>

Allows multiple concatenated compressed streams to be treated as a single
compressed stream. Decompression will stop once either the end of the
file/buffer is reached, an error is encountered (premature eof, corrupt
compressed data) or the end of a stream is not immediately followed by the
start of another stream.

This parameter defaults to 0.

=item C<< Prime => $string >>

This option will uncompress the contents of C<$string> before processing the
input file/buffer.

This option can be useful when the compressed data is embedded in another
file/data structure and it is not possible to work out where the compressed
data begins without having to read the first few bytes. If this is the
case, the uncompression can be I<primed> with these bytes using this
option.

=item C<< Transparent => 0|1 >>

If this option is set and the input file/buffer is not compressed data,
the module will allow reading of it anyway.

In addition, if the input file/buffer does contain compressed data and
there is non-compressed data immediately following it, setting this option
will make this module treat the whole file/buffer as a single data stream.

This option defaults to 1.

=item C<< BlockSize => $num >>

When reading the compressed input data, IO::Uncompress::AnyInflate will read it in
blocks of C<$num> bytes.

This option defaults to 4096.

=item C<< InputLength => $size >>

When present this option will limit the number of compressed bytes read
from the input file/buffer to C<$size>. This option can be used in the
situation where there is useful data directly after the compressed data
stream and you know beforehand the exact length of the compressed data
stream.

This option is mostly used when reading from a filehandle, in which case
the file pointer will be left pointing to the first byte directly after the
compressed data stream.

This option defaults to off.

=item C<< Append => 0|1 >>

This option controls what the C<read> method does with uncompressed data.

If set to 1, all uncompressed data will be appended to the output parameter
of the C<read> method.

If set to 0, the contents of the output parameter of the C<read> method
will be overwritten by the uncompressed data.

Defaults to 0.

=item C<< Strict => 0|1 >>

This option controls whether the extra checks defined below are used when
carrying out the decompression. When Strict is on, the extra tests are
carried out, when Strict is off they are not.

The default for this option is off.

If the input is an RFC 1950 data stream, the following will be checked:

=over 5

=item 1

The ADLER32 checksum field must be present.

=item 2

The value of the ADLER32 field read must match the adler32 value of the
uncompressed data actually contained in the file.

=back

If the input is a gzip (RFC 1952) data stream, the following will be checked:

=over 5

=item 1

If the FHCRC bit is set in the gzip FLG header byte, the CRC16 bytes in the
header must match the crc16 value of the gzip header actually read.

=item 2

If the gzip header contains a name field (FNAME) it consists solely of ISO
8859-1 characters.

=item 3

If the gzip header contains a comment field (FCOMMENT) it consists solely
of ISO 8859-1 characters plus line-feed.

=item 4

If the gzip FEXTRA header field is present it must conform to the sub-field
structure as defined in RFC 1952.

=item 5

The CRC32 and ISIZE trailer fields must be present.

=item 6

The value of the CRC32 field read must match the crc32 value of the
uncompressed data actually contained in the gzip file.

=item 7

The value of the ISIZE fields read must match the length of the
uncompressed data actually read from the file.

=back

=item C<< RawInflate => 0|1 >>

When auto-detecting the compressed format, try to test for raw-deflate (RFC
1951) content using the C<IO::Uncompress::RawInflate> module.

The reason this is not default behaviour is because RFC 1951 content can
only be detected by attempting to uncompress it. This process is error
prone and can result is false positives.

Defaults to 0.

=item C<< ParseExtra => 0|1 >>
If the gzip FEXTRA header field is present and this option is set, it will
force the module to check that it conforms to the sub-field structure as
defined in RFC 1952.

If the C<Strict> is on it will automatically enable this option.

Defaults to 0.

=back

=head2 Examples

TODO

=head1 Methods

=head2 read

Usage is

    $status = $z->read($buffer)

Reads a block of compressed data (the size of the compressed block is
determined by the C<Buffer> option in the constructor), uncompresses it and
writes any uncompressed data into C<$buffer>. If the C<Append> parameter is
set in the constructor, the uncompressed data will be appended to the
C<$buffer> parameter. Otherwise C<$buffer> will be overwritten.

Returns the number of uncompressed bytes written to C<$buffer>, zero if eof
or a negative number on error.

=head2 read

Usage is

    $status = $z->read($buffer, $length)
    $status = $z->read($buffer, $length, $offset)

    $status = read($z, $buffer, $length)
    $status = read($z, $buffer, $length, $offset)

Attempt to read C<$length> bytes of uncompressed data into C<$buffer>.

The main difference between this form of the C<read> method and the
previous one, is that this one will attempt to return I<exactly> C<$length>
bytes. The only circumstances that this function will not is if end-of-file
or an IO error is encountered.

Returns the number of uncompressed bytes written to C<$buffer>, zero if eof
or a negative number on error.

=head2 getline

Usage is

    $line = $z->getline()
    $line = <$z>

Reads a single line.

This method fully supports the use of the variable C<$/> (or
C<$INPUT_RECORD_SEPARATOR> or C<$RS> when C<English> is in use) to
determine what constitutes an end of line. Paragraph mode, record mode and
file slurp mode are all supported.

=head2 getc

Usage is

    $char = $z->getc()

Read a single character.

=head2 ungetc

Usage is

    $char = $z->ungetc($string)

=head2 inflateSync

Usage is

    $status = $z->inflateSync()

TODO

=head2 getHeaderInfo

Usage is

    $hdr  = $z->getHeaderInfo();
    @hdrs = $z->getHeaderInfo();

This method returns either a hash reference (in scalar context) or a list
or hash references (in array context) that contains information about each
of the header fields in the compressed data stream(s).

=head2 tell

Usage is

    $z->tell()
    tell $z

Returns the uncompressed file offset.

=head2 eof

Usage is

    $z->eof();
    eof($z);

Returns true if the end of the compressed input stream has been reached.

=head2 seek

    $z->seek($position, $whence);
    seek($z, $position, $whence);

Provides a sub-set of the C<seek> functionality, with the restriction
that it is only legal to seek forward in the input file/buffer.
It is a fatal error to attempt to seek backward.

Note that the implementation of C<seek> in this module does not provide
true random access to a compressed file/buffer. It  works by uncompressing
data from the current offset in the file/buffer until it reaches the
uncompressed offset specified in the parameters to C<seek>. For very small
files this may be acceptable behaviour. For large files it may cause an
unacceptable delay.

The C<$whence> parameter takes one the usual values, namely SEEK_SET,
SEEK_CUR or SEEK_END.

Returns 1 on success, 0 on failure.

=head2 binmode

Usage is

    $z->binmode
    binmode $z ;

This is a noop provided for completeness.

=head2 opened

    $z->opened()

Returns true if the object currently refers to a opened file/buffer.

=head2 autoflush

    my $prev = $z->autoflush()
    my $prev = $z->autoflush(EXPR)

If the C<$z> object is associated with a file or a filehandle, this method
returns the current autoflush setting for the underlying filehandle. If
C<EXPR> is present, and is non-zero, it will enable flushing after every
write/print operation.

If C<$z> is associated with a buffer, this method has no effect and always
returns C<undef>.

B<Note> that the special variable C<$|> B<cannot> be used to set or
retrieve the autoflush setting.

=head2 input_line_number

    $z->input_line_number()
    $z->input_line_number(EXPR)

Returns the current uncompressed line number. If C<EXPR> is present it has
the effect of setting the line number. Note that setting the line number
does not change the current position within the file/buffer being read.

The contents of C<$/> are used to determine what constitutes a line
terminator.

=head2 fileno

    $z->fileno()
    fileno($z)

If the C<$z> object is associated with a file or a filehandle, C<fileno>
will return the underlying file descriptor. Once the C<close> method is
called C<fileno> will return C<undef>.

If the C<$z> object is associated with a buffer, this method will return
C<undef>.

=head2 close

    $z->close() ;
    close $z ;

Closes the output file/buffer.

For most versions of Perl this method will be automatically invoked if
the IO::Uncompress::AnyInflate object is destroyed (either explicitly or by the
variable with the reference to the object going out of scope). The
exceptions are Perl versions 5.005 through 5.00504 and 5.8.0. In
these cases, the C<close> method will be called automatically, but
not until global destruction of all live objects when the program is
terminating.

Therefore, if you want your scripts to be able to run on all versions
of Perl, you should call C<close> explicitly and not rely on automatic
closing.

Returns true on success, otherwise 0.

If the C<AutoClose> option has been enabled when the IO::Uncompress::AnyInflate
object was created, and the object is associated with a file, the
underlying file will also be closed.

=head2 nextStream

Usage is

    my $status = $z->nextStream();

Skips to the next compressed data stream in the input file/buffer. If a new
compressed data stream is found, the eof marker will be cleared and C<$.>
will be reset to 0.

Returns 1 if a new stream was found, 0 if none was found, and -1 if an
error was encountered.

=head2 trailingData

Usage is

    my $data = $z->trailingData();

Returns the data, if any, that is present immediately after the compressed
data stream once uncompression is complete. It only makes sense to call
this method once the end of the compressed data stream has been
encountered.

This option can be used when there is useful information immediately
following the compressed data stream, and you don't know the length of the
compressed data stream.

If the input is a buffer, C<trailingData> will return everything from the
end of the compressed data stream to the end of the buffer.

If the input is a filehandle, C<trailingData> will return the data that is
left in the filehandle input buffer once the end of the compressed data
stream has been reached. You can then use the filehandle to read the rest
of the input file.

Don't bother using C<trailingData> if the input is a filename.

If you know the length of the compressed data stream before you start
uncompressing, you can avoid having to use C<trailingData> by setting the
C<InputLength> option in the constructor.

=head1 Importing

No symbolic constants are required by IO::Uncompress::AnyInflate at present.

=over 5

=item :all

Imports C<anyinflate> and C<$AnyInflateError>.
Same as doing this

    use IO::Uncompress::AnyInflate qw(anyinflate $AnyInflateError) ;

=back

=head1 EXAMPLES

=head2 Working with Net::FTP

See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP">

=head1 SUPPORT

General feedback/questions/bug reports should be sent to
L<https://github.com/pmqs/IO-Compress/issues> (preferred) or
L<https://rt.cpan.org/Public/Dist/Display.html?Name=IO-Compress>.

=head1 SEE ALSO

L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzip>, L<IO::Uncompress::UnLzip>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Compress::Zstd>, L<IO::Uncompress::UnZstd>, L<IO::Uncompress::AnyUncompress>

L<IO::Compress::FAQ|IO::Compress::FAQ>

L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>,
L<Archive::Tar|Archive::Tar>,
L<IO::Zlib|IO::Zlib>

For RFC 1950, 1951 and 1952 see
L<http://www.faqs.org/rfcs/rfc1950.html>,
L<http://www.faqs.org/rfcs/rfc1951.html> and
L<http://www.faqs.org/rfcs/rfc1952.html>

The I<zlib> compression library was written by Jean-loup Gailly
C<gzip@prep.ai.mit.edu> and Mark Adler C<madler@alumni.caltech.edu>.

The primary site for the I<zlib> compression library is
L<http://www.zlib.org>.

The primary site for gzip is L<http://www.gzip.org>.

=head1 AUTHOR

This module was written by Paul Marquess, C<pmqs@cpan.org>.

=head1 MODIFICATION HISTORY

See the Changes file.

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2005-2021 Paul Marquess. All rights reserved.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
                                                                                                                                                                                                                                                                                                                                                                                                                      Uncompress/Inflate.pm                                                                               0000644                 00000067250 00000000000 0010575 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       package IO::Uncompress::Inflate ;
# for RFC1950

use strict ;
use warnings;
use bytes;

use IO::Compress::Base::Common  2.101 qw(:Status );
use IO::Compress::Zlib::Constants 2.101 ;

use IO::Uncompress::RawInflate  2.101 ;

require Exporter ;
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $InflateError);

$VERSION = '2.102';
$InflateError = '';

@ISA    = qw(IO::Uncompress::RawInflate Exporter);
@EXPORT_OK = qw( $InflateError inflate ) ;
%EXPORT_TAGS = %IO::Uncompress::RawInflate::DEFLATE_CONSTANTS ;
push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
Exporter::export_ok_tags('all');


sub new
{
    my $class = shift ;
    my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$InflateError);

    $obj->_create(undef, 0, @_);
}

sub inflate
{
    my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$InflateError);
    return $obj->_inf(@_);
}

sub getExtraParams
{
    return ();
}

sub ckParams
{
    my $self = shift ;
    my $got = shift ;

    # gunzip always needs adler32
    $got->setValue('adler32' => 1);

    return 1;
}

sub ckMagic
{
    my $self = shift;

    my $magic ;
    $self->smartReadExact(\$magic, ZLIB_HEADER_SIZE);

    *$self->{HeaderPending} = $magic ;

    return $self->HeaderError("Header size is " .
                                        ZLIB_HEADER_SIZE . " bytes")
        if length $magic != ZLIB_HEADER_SIZE;

    #return $self->HeaderError("CRC mismatch.")
    return undef
        if ! $self->isZlibMagic($magic) ;

    *$self->{Type} = 'rfc1950';
    return $magic;
}

sub readHeader
{
    my $self = shift;
    my $magic = shift ;

    return $self->_readDeflateHeader($magic) ;
}

sub chkTrailer
{
    my $self = shift;
    my $trailer = shift;

    my $ADLER32 = unpack("N", $trailer) ;
    *$self->{Info}{ADLER32} = $ADLER32;
    return $self->TrailerError("CRC mismatch")
        if *$self->{Strict} && $ADLER32 != *$self->{Uncomp}->adler32() ;

    return STATUS_OK;
}



sub isZlibMagic
{
    my $self = shift;
    my $buffer = shift ;

    return 0
        if length $buffer < ZLIB_HEADER_SIZE ;

    my $hdr = unpack("n", $buffer) ;
    #return 0 if $hdr % 31 != 0 ;
    return $self->HeaderError("CRC mismatch.")
        if $hdr % 31 != 0 ;

    my ($CMF, $FLG) = unpack "C C", $buffer;
    my $cm =    bits($CMF, ZLIB_CMF_CM_OFFSET,    ZLIB_CMF_CM_BITS) ;

    # Only Deflate supported
    return $self->HeaderError("Not Deflate (CM is $cm)")
        if $cm != ZLIB_CMF_CM_DEFLATED ;

    # Max window value is 7 for Deflate.
    my $cinfo = bits($CMF, ZLIB_CMF_CINFO_OFFSET, ZLIB_CMF_CINFO_BITS) ;
    return $self->HeaderError("CINFO > " . ZLIB_CMF_CINFO_MAX .
                              " (CINFO is $cinfo)")
        if $cinfo > ZLIB_CMF_CINFO_MAX ;

    return 1;
}

sub bits
{
    my $data   = shift ;
    my $offset = shift ;
    my $mask  = shift ;

    ($data >> $offset ) & $mask & 0xFF ;
}


sub _readDeflateHeader
{
    my ($self, $buffer) = @_ ;

#    if (! $buffer) {
#        $self->smartReadExact(\$buffer, ZLIB_HEADER_SIZE);
#
#        *$self->{HeaderPending} = $buffer ;
#
#        return $self->HeaderError("Header size is " .
#                                            ZLIB_HEADER_SIZE . " bytes")
#            if length $buffer != ZLIB_HEADER_SIZE;
#
#        return $self->HeaderError("CRC mismatch.")
#            if ! isZlibMagic($buffer) ;
#    }

    my ($CMF, $FLG) = unpack "C C", $buffer;
    my $FDICT = bits($FLG, ZLIB_FLG_FDICT_OFFSET,  ZLIB_FLG_FDICT_BITS ),

    my $cm = bits($CMF, ZLIB_CMF_CM_OFFSET, ZLIB_CMF_CM_BITS) ;
    $cm == ZLIB_CMF_CM_DEFLATED
        or return $self->HeaderError("Not Deflate (CM is $cm)") ;

    my $DICTID;
    if ($FDICT) {
        $self->smartReadExact(\$buffer, ZLIB_FDICT_SIZE)
            or return $self->TruncatedHeader("FDICT");

        $DICTID = unpack("N", $buffer) ;
    }

    *$self->{Type} = 'rfc1950';

    return {
        'Type'          => 'rfc1950',
        'FingerprintLength'  => ZLIB_HEADER_SIZE,
        'HeaderLength'  => ZLIB_HEADER_SIZE,
        'TrailerLength' => ZLIB_TRAILER_SIZE,
        'Header'        => $buffer,

        CMF     =>      $CMF                                               ,
        CM      => bits($CMF, ZLIB_CMF_CM_OFFSET,     ZLIB_CMF_CM_BITS    ),
        CINFO   => bits($CMF, ZLIB_CMF_CINFO_OFFSET,  ZLIB_CMF_CINFO_BITS ),
        FLG     =>      $FLG                                               ,
        FCHECK  => bits($FLG, ZLIB_FLG_FCHECK_OFFSET, ZLIB_FLG_FCHECK_BITS),
        FDICT   => bits($FLG, ZLIB_FLG_FDICT_OFFSET,  ZLIB_FLG_FDICT_BITS ),
        FLEVEL  => bits($FLG, ZLIB_FLG_LEVEL_OFFSET,  ZLIB_FLG_LEVEL_BITS ),
        DICTID  =>      $DICTID                                            ,

    };
}




1 ;

__END__


=head1 NAME

IO::Uncompress::Inflate - Read RFC 1950 files/buffers

=head1 SYNOPSIS

    use IO::Uncompress::Inflate qw(inflate $InflateError) ;

    my $status = inflate $input => $output [,OPTS]
        or die "inflate failed: $InflateError\n";

    my $z = IO::Uncompress::Inflate->new( $input [OPTS] )
        or die "inflate failed: $InflateError\n";

    $status = $z->read($buffer)
    $status = $z->read($buffer, $length)
    $status = $z->read($buffer, $length, $offset)
    $line = $z->getline()
    $char = $z->getc()
    $char = $z->ungetc()
    $char = $z->opened()

    $status = $z->inflateSync()

    $data = $z->trailingData()
    $status = $z->nextStream()
    $data = $z->getHeaderInfo()
    $z->tell()
    $z->seek($position, $whence)
    $z->binmode()
    $z->fileno()
    $z->eof()
    $z->close()

    $InflateError ;

    # IO::File mode

    <$z>
    read($z, $buffer);
    read($z, $buffer, $length);
    read($z, $buffer, $length, $offset);
    tell($z)
    seek($z, $position, $whence)
    binmode($z)
    fileno($z)
    eof($z)
    close($z)

=head1 DESCRIPTION

This module provides a Perl interface that allows the reading of
files/buffers that conform to RFC 1950.

For writing RFC 1950 files/buffers, see the companion module IO::Compress::Deflate.

=head1 Functional Interface

A top-level function, C<inflate>, is provided to carry out
"one-shot" uncompression between buffers and/or files. For finer
control over the uncompression process, see the L</"OO Interface">
section.

    use IO::Uncompress::Inflate qw(inflate $InflateError) ;

    inflate $input_filename_or_reference => $output_filename_or_reference [,OPTS]
        or die "inflate failed: $InflateError\n";

The functional interface needs Perl5.005 or better.

=head2 inflate $input_filename_or_reference => $output_filename_or_reference [, OPTS]

C<inflate> expects at least two parameters,
C<$input_filename_or_reference> and C<$output_filename_or_reference>
and zero or more optional parameters (see L</Optional Parameters>)

=head3 The C<$input_filename_or_reference> parameter

The parameter, C<$input_filename_or_reference>, is used to define the
source of the compressed data.

It can take one of the following forms:

=over 5

=item A filename

If the C<$input_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename. This file will be opened for reading and the
input data will be read from it.

=item A filehandle

If the C<$input_filename_or_reference> parameter is a filehandle, the input
data will be read from it.  The string '-' can be used as an alias for
standard input.

=item A scalar reference

If C<$input_filename_or_reference> is a scalar reference, the input data
will be read from C<$$input_filename_or_reference>.

=item An array reference

If C<$input_filename_or_reference> is an array reference, each element in
the array must be a filename.

The input data will be read from each file in turn.

The complete array will be walked to ensure that it only
contains valid filenames before any data is uncompressed.

=item An Input FileGlob string

If C<$input_filename_or_reference> is a string that is delimited by the
characters "<" and ">" C<inflate> will assume that it is an
I<input fileglob string>. The input is the list of files that match the
fileglob.

See L<File::GlobMapper|File::GlobMapper> for more details.

=back

If the C<$input_filename_or_reference> parameter is any other type,
C<undef> will be returned.

=head3 The C<$output_filename_or_reference> parameter

The parameter C<$output_filename_or_reference> is used to control the
destination of the uncompressed data. This parameter can take one of
these forms.

=over 5

=item A filename

If the C<$output_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename.  This file will be opened for writing and the
uncompressed data will be written to it.

=item A filehandle

If the C<$output_filename_or_reference> parameter is a filehandle, the
uncompressed data will be written to it.  The string '-' can be used as
an alias for standard output.

=item A scalar reference

If C<$output_filename_or_reference> is a scalar reference, the
uncompressed data will be stored in C<$$output_filename_or_reference>.

=item An Array Reference

If C<$output_filename_or_reference> is an array reference,
the uncompressed data will be pushed onto the array.

=item An Output FileGlob

If C<$output_filename_or_reference> is a string that is delimited by the
characters "<" and ">" C<inflate> will assume that it is an
I<output fileglob string>. The output is the list of files that match the
fileglob.

When C<$output_filename_or_reference> is an fileglob string,
C<$input_filename_or_reference> must also be a fileglob string. Anything
else is an error.

See L<File::GlobMapper|File::GlobMapper> for more details.

=back

If the C<$output_filename_or_reference> parameter is any other type,
C<undef> will be returned.

=head2 Notes

When C<$input_filename_or_reference> maps to multiple compressed
files/buffers and C<$output_filename_or_reference> is
a single file/buffer, after uncompression C<$output_filename_or_reference> will contain a
concatenation of all the uncompressed data from each of the input
files/buffers.

=head2 Optional Parameters

The optional parameters for the one-shot function C<inflate>
are (for the most part) identical to those used with the OO interface defined in the
L</"Constructor Options"> section. The exceptions are listed below

=over 5

=item C<< AutoClose => 0|1 >>

This option applies to any input or output data streams to
C<inflate> that are filehandles.

If C<AutoClose> is specified, and the value is true, it will result in all
input and/or output filehandles being closed once C<inflate> has
completed.

This parameter defaults to 0.

=item C<< BinModeOut => 0|1 >>

This option is now a no-op. All files will be written  in binmode.

=item C<< Append => 0|1 >>

The behaviour of this option is dependent on the type of output data
stream.

=over 5

=item * A Buffer

If C<Append> is enabled, all uncompressed data will be append to the end of
the output buffer. Otherwise the output buffer will be cleared before any
uncompressed data is written to it.

=item * A Filename

If C<Append> is enabled, the file will be opened in append mode. Otherwise
the contents of the file, if any, will be truncated before any uncompressed
data is written to it.

=item * A Filehandle

If C<Append> is enabled, the filehandle will be positioned to the end of
the file via a call to C<seek> before any uncompressed data is
written to it.  Otherwise the file pointer will not be moved.

=back

When C<Append> is specified, and set to true, it will I<append> all uncompressed
data to the output data stream.

So when the output is a filehandle it will carry out a seek to the eof
before writing any uncompressed data. If the output is a filename, it will be opened for
appending. If the output is a buffer, all uncompressed data will be
appended to the existing buffer.

Conversely when C<Append> is not specified, or it is present and is set to
false, it will operate as follows.

When the output is a filename, it will truncate the contents of the file
before writing any uncompressed data. If the output is a filehandle
its position will not be changed. If the output is a buffer, it will be
wiped before any uncompressed data is output.

Defaults to 0.

=item C<< MultiStream => 0|1 >>

If the input file/buffer contains multiple compressed data streams, this
option will uncompress the whole lot as a single data stream.

Defaults to 0.

=item C<< TrailingData => $scalar >>

Returns the data, if any, that is present immediately after the compressed
data stream once uncompression is complete.

This option can be used when there is useful information immediately
following the compressed data stream, and you don't know the length of the
compressed data stream.

If the input is a buffer, C<trailingData> will return everything from the
end of the compressed data stream to the end of the buffer.

If the input is a filehandle, C<trailingData> will return the data that is
left in the filehandle input buffer once the end of the compressed data
stream has been reached. You can then use the filehandle to read the rest
of the input file.

Don't bother using C<trailingData> if the input is a filename.

If you know the length of the compressed data stream before you start
uncompressing, you can avoid having to use C<trailingData> by setting the
C<InputLength> option.

=back

=head2 Examples

To read the contents of the file C<file1.txt.1950> and write the
uncompressed data to the file C<file1.txt>.

    use strict ;
    use warnings ;
    use IO::Uncompress::Inflate qw(inflate $InflateError) ;

    my $input = "file1.txt.1950";
    my $output = "file1.txt";
    inflate $input => $output
        or die "inflate failed: $InflateError\n";

To read from an existing Perl filehandle, C<$input>, and write the
uncompressed data to a buffer, C<$buffer>.

    use strict ;
    use warnings ;
    use IO::Uncompress::Inflate qw(inflate $InflateError) ;
    use IO::File ;

    my $input = IO::File->new( "<file1.txt.1950" )
        or die "Cannot open 'file1.txt.1950': $!\n" ;
    my $buffer ;
    inflate $input => \$buffer
        or die "inflate failed: $InflateError\n";

To uncompress all files in the directory "/my/home" that match "*.txt.1950" and store the compressed data in the same directory

    use strict ;
    use warnings ;
    use IO::Uncompress::Inflate qw(inflate $InflateError) ;

    inflate '</my/home/*.txt.1950>' => '</my/home/#1.txt>'
        or die "inflate failed: $InflateError\n";

and if you want to compress each file one at a time, this will do the trick

    use strict ;
    use warnings ;
    use IO::Uncompress::Inflate qw(inflate $InflateError) ;

    for my $input ( glob "/my/home/*.txt.1950" )
    {
        my $output = $input;
        $output =~ s/.1950// ;
        inflate $input => $output
            or die "Error compressing '$input': $InflateError\n";
    }

=head1 OO Interface

=head2 Constructor

The format of the constructor for IO::Uncompress::Inflate is shown below

    my $z = IO::Uncompress::Inflate->new( $input [OPTS] )
        or die "IO::Uncompress::Inflate failed: $InflateError\n";

Returns an C<IO::Uncompress::Inflate> object on success and undef on failure.
The variable C<$InflateError> will contain an error message on failure.

If you are running Perl 5.005 or better the object, C<$z>, returned from
IO::Uncompress::Inflate can be used exactly like an L<IO::File|IO::File> filehandle.
This means that all normal input file operations can be carried out with
C<$z>.  For example, to read a line from a compressed file/buffer you can
use either of these forms

    $line = $z->getline();
    $line = <$z>;

The mandatory parameter C<$input> is used to determine the source of the
compressed data. This parameter can take one of three forms.

=over 5

=item A filename

If the C<$input> parameter is a scalar, it is assumed to be a filename. This
file will be opened for reading and the compressed data will be read from it.

=item A filehandle

If the C<$input> parameter is a filehandle, the compressed data will be
read from it.
The string '-' can be used as an alias for standard input.

=item A scalar reference

If C<$input> is a scalar reference, the compressed data will be read from
C<$$input>.

=back

=head2 Constructor Options

The option names defined below are case insensitive and can be optionally
prefixed by a '-'.  So all of the following are valid

    -AutoClose
    -autoclose
    AUTOCLOSE
    autoclose

OPTS is a combination of the following options:

=over 5

=item C<< AutoClose => 0|1 >>

This option is only valid when the C<$input> parameter is a filehandle. If
specified, and the value is true, it will result in the file being closed once
either the C<close> method is called or the IO::Uncompress::Inflate object is
destroyed.

This parameter defaults to 0.

=item C<< MultiStream => 0|1 >>

Allows multiple concatenated compressed streams to be treated as a single
compressed stream. Decompression will stop once either the end of the
file/buffer is reached, an error is encountered (premature eof, corrupt
compressed data) or the end of a stream is not immediately followed by the
start of another stream.

This parameter defaults to 0.

=item C<< Prime => $string >>

This option will uncompress the contents of C<$string> before processing the
input file/buffer.

This option can be useful when the compressed data is embedded in another
file/data structure and it is not possible to work out where the compressed
data begins without having to read the first few bytes. If this is the
case, the uncompression can be I<primed> with these bytes using this
option.

=item C<< Transparent => 0|1 >>

If this option is set and the input file/buffer is not compressed data,
the module will allow reading of it anyway.

In addition, if the input file/buffer does contain compressed data and
there is non-compressed data immediately following it, setting this option
will make this module treat the whole file/buffer as a single data stream.

This option defaults to 1.

=item C<< BlockSize => $num >>

When reading the compressed input data, IO::Uncompress::Inflate will read it in
blocks of C<$num> bytes.

This option defaults to 4096.

=item C<< InputLength => $size >>

When present this option will limit the number of compressed bytes read
from the input file/buffer to C<$size>. This option can be used in the
situation where there is useful data directly after the compressed data
stream and you know beforehand the exact length of the compressed data
stream.

This option is mostly used when reading from a filehandle, in which case
the file pointer will be left pointing to the first byte directly after the
compressed data stream.

This option defaults to off.

=item C<< Append => 0|1 >>

This option controls what the C<read> method does with uncompressed data.

If set to 1, all uncompressed data will be appended to the output parameter
of the C<read> method.

If set to 0, the contents of the output parameter of the C<read> method
will be overwritten by the uncompressed data.

Defaults to 0.

=item C<< Strict => 0|1 >>

This option controls whether the extra checks defined below are used when
carrying out the decompression. When Strict is on, the extra tests are
carried out, when Strict is off they are not.

The default for this option is off.

=over 5

=item 1

The ADLER32 checksum field must be present.

=item 2

The value of the ADLER32 field read must match the adler32 value of the
uncompressed data actually contained in the file.

=back

=back

=head2 Examples

TODO

=head1 Methods

=head2 read

Usage is

    $status = $z->read($buffer)

Reads a block of compressed data (the size of the compressed block is
determined by the C<Buffer> option in the constructor), uncompresses it and
writes any uncompressed data into C<$buffer>. If the C<Append> parameter is
set in the constructor, the uncompressed data will be appended to the
C<$buffer> parameter. Otherwise C<$buffer> will be overwritten.

Returns the number of uncompressed bytes written to C<$buffer>, zero if eof
or a negative number on error.

=head2 read

Usage is

    $status = $z->read($buffer, $length)
    $status = $z->read($buffer, $length, $offset)

    $status = read($z, $buffer, $length)
    $status = read($z, $buffer, $length, $offset)

Attempt to read C<$length> bytes of uncompressed data into C<$buffer>.

The main difference between this form of the C<read> method and the
previous one, is that this one will attempt to return I<exactly> C<$length>
bytes. The only circumstances that this function will not is if end-of-file
or an IO error is encountered.

Returns the number of uncompressed bytes written to C<$buffer>, zero if eof
or a negative number on error.

=head2 getline

Usage is

    $line = $z->getline()
    $line = <$z>

Reads a single line.

This method fully supports the use of the variable C<$/> (or
C<$INPUT_RECORD_SEPARATOR> or C<$RS> when C<English> is in use) to
determine what constitutes an end of line. Paragraph mode, record mode and
file slurp mode are all supported.

=head2 getc

Usage is

    $char = $z->getc()

Read a single character.

=head2 ungetc

Usage is

    $char = $z->ungetc($string)

=head2 inflateSync

Usage is

    $status = $z->inflateSync()

TODO

=head2 getHeaderInfo

Usage is

    $hdr  = $z->getHeaderInfo();
    @hdrs = $z->getHeaderInfo();

This method returns either a hash reference (in scalar context) or a list
or hash references (in array context) that contains information about each
of the header fields in the compressed data stream(s).

=head2 tell

Usage is

    $z->tell()
    tell $z

Returns the uncompressed file offset.

=head2 eof

Usage is

    $z->eof();
    eof($z);

Returns true if the end of the compressed input stream has been reached.

=head2 seek

    $z->seek($position, $whence);
    seek($z, $position, $whence);

Provides a sub-set of the C<seek> functionality, with the restriction
that it is only legal to seek forward in the input file/buffer.
It is a fatal error to attempt to seek backward.

Note that the implementation of C<seek> in this module does not provide
true random access to a compressed file/buffer. It  works by uncompressing
data from the current offset in the file/buffer until it reaches the
uncompressed offset specified in the parameters to C<seek>. For very small
files this may be acceptable behaviour. For large files it may cause an
unacceptable delay.

The C<$whence> parameter takes one the usual values, namely SEEK_SET,
SEEK_CUR or SEEK_END.

Returns 1 on success, 0 on failure.

=head2 binmode

Usage is

    $z->binmode
    binmode $z ;

This is a noop provided for completeness.

=head2 opened

    $z->opened()

Returns true if the object currently refers to a opened file/buffer.

=head2 autoflush

    my $prev = $z->autoflush()
    my $prev = $z->autoflush(EXPR)

If the C<$z> object is associated with a file or a filehandle, this method
returns the current autoflush setting for the underlying filehandle. If
C<EXPR> is present, and is non-zero, it will enable flushing after every
write/print operation.

If C<$z> is associated with a buffer, this method has no effect and always
returns C<undef>.

B<Note> that the special variable C<$|> B<cannot> be used to set or
retrieve the autoflush setting.

=head2 input_line_number

    $z->input_line_number()
    $z->input_line_number(EXPR)

Returns the current uncompressed line number. If C<EXPR> is present it has
the effect of setting the line number. Note that setting the line number
does not change the current position within the file/buffer being read.

The contents of C<$/> are used to determine what constitutes a line
terminator.

=head2 fileno

    $z->fileno()
    fileno($z)

If the C<$z> object is associated with a file or a filehandle, C<fileno>
will return the underlying file descriptor. Once the C<close> method is
called C<fileno> will return C<undef>.

If the C<$z> object is associated with a buffer, this method will return
C<undef>.

=head2 close

    $z->close() ;
    close $z ;

Closes the output file/buffer.

For most versions of Perl this method will be automatically invoked if
the IO::Uncompress::Inflate object is destroyed (either explicitly or by the
variable with the reference to the object going out of scope). The
exceptions are Perl versions 5.005 through 5.00504 and 5.8.0. In
these cases, the C<close> method will be called automatically, but
not until global destruction of all live objects when the program is
terminating.

Therefore, if you want your scripts to be able to run on all versions
of Perl, you should call C<close> explicitly and not rely on automatic
closing.

Returns true on success, otherwise 0.

If the C<AutoClose> option has been enabled when the IO::Uncompress::Inflate
object was created, and the object is associated with a file, the
underlying file will also be closed.

=head2 nextStream

Usage is

    my $status = $z->nextStream();

Skips to the next compressed data stream in the input file/buffer. If a new
compressed data stream is found, the eof marker will be cleared and C<$.>
will be reset to 0.

Returns 1 if a new stream was found, 0 if none was found, and -1 if an
error was encountered.

=head2 trailingData

Usage is

    my $data = $z->trailingData();

Returns the data, if any, that is present immediately after the compressed
data stream once uncompression is complete. It only makes sense to call
this method once the end of the compressed data stream has been
encountered.

This option can be used when there is useful information immediately
following the compressed data stream, and you don't know the length of the
compressed data stream.

If the input is a buffer, C<trailingData> will return everything from the
end of the compressed data stream to the end of the buffer.

If the input is a filehandle, C<trailingData> will return the data that is
left in the filehandle input buffer once the end of the compressed data
stream has been reached. You can then use the filehandle to read the rest
of the input file.

Don't bother using C<trailingData> if the input is a filename.

If you know the length of the compressed data stream before you start
uncompressing, you can avoid having to use C<trailingData> by setting the
C<InputLength> option in the constructor.

=head1 Importing

No symbolic constants are required by IO::Uncompress::Inflate at present.

=over 5

=item :all

Imports C<inflate> and C<$InflateError>.
Same as doing this

    use IO::Uncompress::Inflate qw(inflate $InflateError) ;

=back

=head1 EXAMPLES

=head2 Working with Net::FTP

See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP">

=head1 SUPPORT

General feedback/questions/bug reports should be sent to
L<https://github.com/pmqs/IO-Compress/issues> (preferred) or
L<https://rt.cpan.org/Public/Dist/Display.html?Name=IO-Compress>.

=head1 SEE ALSO

L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzip>, L<IO::Uncompress::UnLzip>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Compress::Zstd>, L<IO::Uncompress::UnZstd>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>

L<IO::Compress::FAQ|IO::Compress::FAQ>

L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>,
L<Archive::Tar|Archive::Tar>,
L<IO::Zlib|IO::Zlib>

For RFC 1950, 1951 and 1952 see
L<http://www.faqs.org/rfcs/rfc1950.html>,
L<http://www.faqs.org/rfcs/rfc1951.html> and
L<http://www.faqs.org/rfcs/rfc1952.html>

The I<zlib> compression library was written by Jean-loup Gailly
C<gzip@prep.ai.mit.edu> and Mark Adler C<madler@alumni.caltech.edu>.

The primary site for the I<zlib> compression library is
L<http://www.zlib.org>.

The primary site for gzip is L<http://www.gzip.org>.

=head1 AUTHOR

This module was written by Paul Marquess, C<pmqs@cpan.org>.

=head1 MODIFICATION HISTORY

See the Changes file.

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2005-2021 Paul Marquess. All rights reserved.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
                                                                                                                                                                                                                                                                                                                                                        Uncompress/Base.pm                                                                                  0000644                 00000112701 00000000000 0010055 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       
package IO::Uncompress::Base ;

use strict ;
use warnings;
use bytes;

our (@ISA, $VERSION, @EXPORT_OK, %EXPORT_TAGS);
@ISA    = qw(IO::File Exporter);


$VERSION = '2.102';

use constant G_EOF => 0 ;
use constant G_ERR => -1 ;

use IO::Compress::Base::Common 2.101 ;

use IO::File ;
use Symbol;
use Scalar::Util ();
use List::Util ();
use Carp ;

%EXPORT_TAGS = ( );
push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;

sub smartRead
{
    my $self = $_[0];
    my $out = $_[1];
    my $size = $_[2];
    $$out = "" ;

    my $offset = 0 ;
    my $status = 1;


    if (defined *$self->{InputLength}) {
        return 0
            if *$self->{InputLengthRemaining} <= 0 ;
        $size = List::Util::min($size, *$self->{InputLengthRemaining});
    }

    if ( length *$self->{Prime} ) {
        $$out = substr(*$self->{Prime}, 0, $size) ;
        substr(*$self->{Prime}, 0, $size) =  '' ;
        if (length $$out == $size) {
            *$self->{InputLengthRemaining} -= length $$out
                if defined *$self->{InputLength};

            return length $$out ;
        }
        $offset = length $$out ;
    }

    my $get_size = $size - $offset ;

    if (defined *$self->{FH}) {
        if ($offset) {
            # Not using this
            #
            #  *$self->{FH}->read($$out, $get_size, $offset);
            #
            # because the filehandle may not support the offset parameter
            # An example is Net::FTP
            my $tmp = '';
            $status = *$self->{FH}->read($tmp, $get_size) ;
            substr($$out, $offset) = $tmp
                if defined $status && $status > 0 ;
        }
        else
          { $status = *$self->{FH}->read($$out, $get_size) }
    }
    elsif (defined *$self->{InputEvent}) {
        my $got = 1 ;
        while (length $$out < $size) {
            last
                if ($got = *$self->{InputEvent}->($$out, $get_size)) <= 0;
        }

        if (length $$out > $size ) {
            *$self->{Prime} = substr($$out, $size, length($$out));
            substr($$out, $size, length($$out)) =  '';
        }

       *$self->{EventEof} = 1 if $got <= 0 ;
    }
    else {
       no warnings 'uninitialized';
       my $buf = *$self->{Buffer} ;
       $$buf = '' unless defined $$buf ;
       substr($$out, $offset) = substr($$buf, *$self->{BufferOffset}, $get_size);
       if (*$self->{ConsumeInput})
         { substr($$buf, 0, $get_size) = '' }
       else
         { *$self->{BufferOffset} += length($$out) - $offset }
    }

    *$self->{InputLengthRemaining} -= length($$out) #- $offset
        if defined *$self->{InputLength};

    if (! defined $status) {
        $self->saveStatus($!) ;
        return STATUS_ERROR;
    }

    $self->saveStatus(length $$out < 0 ? STATUS_ERROR : STATUS_OK) ;

    return length $$out;
}

sub pushBack
{
    my $self = shift ;

    return if ! defined $_[0] || length $_[0] == 0 ;

    if (defined *$self->{FH} || defined *$self->{InputEvent} ) {
        *$self->{Prime} = $_[0] . *$self->{Prime} ;
        *$self->{InputLengthRemaining} += length($_[0]);
    }
    else {
        my $len = length $_[0];

        if($len > *$self->{BufferOffset}) {
            *$self->{Prime} = substr($_[0], 0, $len - *$self->{BufferOffset}) . *$self->{Prime} ;
            *$self->{InputLengthRemaining} = *$self->{InputLength};
            *$self->{BufferOffset} = 0
        }
        else {
            *$self->{InputLengthRemaining} += length($_[0]);
            *$self->{BufferOffset} -= length($_[0]) ;
        }
    }
}

sub smartSeek
{
    my $self   = shift ;
    my $offset = shift ;
    my $truncate = shift;
    my $position = shift || SEEK_SET;

    # TODO -- need to take prime into account
    *$self->{Prime} = '';
    if (defined *$self->{FH})
      { *$self->{FH}->seek($offset, $position) }
    else {
        if ($position == SEEK_END) {
            *$self->{BufferOffset} = length(${ *$self->{Buffer} }) + $offset ;
        }
        elsif ($position == SEEK_CUR) {
            *$self->{BufferOffset} += $offset ;
        }
        else {
            *$self->{BufferOffset} = $offset ;
        }

        substr(${ *$self->{Buffer} }, *$self->{BufferOffset}) = ''
            if $truncate;
        return 1;
    }
}

sub smartTell
{
    my $self   = shift ;

    if (defined *$self->{FH})
      { return *$self->{FH}->tell() }
    else
      { return *$self->{BufferOffset} }
}

sub smartWrite
{
    my $self   = shift ;
    my $out_data = shift ;

    if (defined *$self->{FH}) {
        # flush needed for 5.8.0
        defined *$self->{FH}->write($out_data, length $out_data) &&
        defined *$self->{FH}->flush() ;
    }
    else {
       my $buf = *$self->{Buffer} ;
       substr($$buf, *$self->{BufferOffset}, length $out_data) = $out_data ;
       *$self->{BufferOffset} += length($out_data) ;
       return 1;
    }
}

sub smartReadExact
{
    return $_[0]->smartRead($_[1], $_[2]) == $_[2];
}

sub smartEof
{
    my ($self) = $_[0];
    local $.;

    return 0 if length *$self->{Prime} || *$self->{PushMode};

    if (defined *$self->{FH})
    {
        # Could use
        #
        #  *$self->{FH}->eof()
        #
        # here, but this can cause trouble if
        # the filehandle is itself a tied handle, but it uses sysread.
        # Then we get into mixing buffered & non-buffered IO,
        # which will cause trouble

        my $info = $self->getErrInfo();

        my $buffer = '';
        my $status = $self->smartRead(\$buffer, 1);
        $self->pushBack($buffer) if length $buffer;
        $self->setErrInfo($info);

        return $status == 0 ;
    }
    elsif (defined *$self->{InputEvent})
     { *$self->{EventEof} }
    else
     { *$self->{BufferOffset} >= length(${ *$self->{Buffer} }) }
}

sub clearError
{
    my $self   = shift ;

    *$self->{ErrorNo}  =  0 ;
    ${ *$self->{Error} } = '' ;
}

sub getErrInfo
{
    my $self   = shift ;

    return [ *$self->{ErrorNo}, ${ *$self->{Error} } ] ;
}

sub setErrInfo
{
    my $self   = shift ;
    my $ref    = shift;

    *$self->{ErrorNo}  =  $ref->[0] ;
    ${ *$self->{Error} } = $ref->[1] ;
}

sub saveStatus
{
    my $self   = shift ;
    my $errno = shift() + 0 ;

    *$self->{ErrorNo}  = $errno;
    ${ *$self->{Error} } = '' ;

    return *$self->{ErrorNo} ;
}


sub saveErrorString
{
    my $self   = shift ;
    my $retval = shift ;

    ${ *$self->{Error} } = shift ;
    *$self->{ErrorNo} = @_ ? shift() + 0 : STATUS_ERROR ;

    return $retval;
}

sub croakError
{
    my $self   = shift ;
    $self->saveErrorString(0, $_[0]);
    croak $_[0];
}


sub closeError
{
    my $self = shift ;
    my $retval = shift ;

    my $errno = *$self->{ErrorNo};
    my $error = ${ *$self->{Error} };

    $self->close();

    *$self->{ErrorNo} = $errno ;
    ${ *$self->{Error} } = $error ;

    return $retval;
}

sub error
{
    my $self   = shift ;
    return ${ *$self->{Error} } ;
}

sub errorNo
{
    my $self   = shift ;
    return *$self->{ErrorNo};
}

sub HeaderError
{
    my ($self) = shift;
    return $self->saveErrorString(undef, "Header Error: $_[0]", STATUS_ERROR);
}

sub TrailerError
{
    my ($self) = shift;
    return $self->saveErrorString(G_ERR, "Trailer Error: $_[0]", STATUS_ERROR);
}

sub TruncatedHeader
{
    my ($self) = shift;
    return $self->HeaderError("Truncated in $_[0] Section");
}

sub TruncatedTrailer
{
    my ($self) = shift;
    return $self->TrailerError("Truncated in $_[0] Section");
}

sub postCheckParams
{
    return 1;
}

sub checkParams
{
    my $self = shift ;
    my $class = shift ;

    my $got = shift || IO::Compress::Base::Parameters::new();

    my $Valid = {
                    'blocksize'     => [IO::Compress::Base::Common::Parse_unsigned, 16 * 1024],
                    'autoclose'     => [IO::Compress::Base::Common::Parse_boolean,  0],
                    'strict'        => [IO::Compress::Base::Common::Parse_boolean,  0],
                    'append'        => [IO::Compress::Base::Common::Parse_boolean,  0],
                    'prime'         => [IO::Compress::Base::Common::Parse_any,      undef],
                    'multistream'   => [IO::Compress::Base::Common::Parse_boolean,  0],
                    'transparent'   => [IO::Compress::Base::Common::Parse_any,      1],
                    'scan'          => [IO::Compress::Base::Common::Parse_boolean,  0],
                    'inputlength'   => [IO::Compress::Base::Common::Parse_unsigned, undef],
                    'binmodeout'    => [IO::Compress::Base::Common::Parse_boolean,  0],
                   #'decode'        => [IO::Compress::Base::Common::Parse_any,      undef],

                   #'consumeinput'  => [IO::Compress::Base::Common::Parse_boolean,  0],

                    $self->getExtraParams(),

                    #'Todo - Revert to ordinary file on end Z_STREAM_END'=> 0,
                    # ContinueAfterEof
                } ;

    $Valid->{trailingdata} = [IO::Compress::Base::Common::Parse_writable_scalar, undef]
        if  *$self->{OneShot} ;

    $got->parse($Valid, @_ )
        or $self->croakError("${class}: " . $got->getError()) ;

    $self->postCheckParams($got)
        or $self->croakError("${class}: " . $self->error()) ;

    return $got;
}

sub _create
{
    my $obj = shift;
    my $got = shift;
    my $append_mode = shift ;

    my $class = ref $obj;
    $obj->croakError("$class: Missing Input parameter")
        if ! @_ && ! $got ;

    my $inValue = shift ;

    *$obj->{OneShot} = 0 ;

    if (! $got)
    {
        $got = $obj->checkParams($class, undef, @_)
            or return undef ;
    }

    my $inType  = whatIsInput($inValue, 1);

    $obj->ckInputParam($class, $inValue, 1)
        or return undef ;

    *$obj->{InNew} = 1;

    $obj->ckParams($got)
        or $obj->croakError("${class}: " . *$obj->{Error});

    if ($inType eq 'buffer' || $inType eq 'code') {
        *$obj->{Buffer} = $inValue ;
        *$obj->{InputEvent} = $inValue
           if $inType eq 'code' ;
    }
    else {
        if ($inType eq 'handle') {
            *$obj->{FH} = $inValue ;
            *$obj->{Handle} = 1 ;

            # Need to rewind for Scan
            *$obj->{FH}->seek(0, SEEK_SET)
                if $got->getValue('scan');
        }
        else {
            no warnings ;
            my $mode = '<';
            $mode = '+<' if $got->getValue('scan');
            *$obj->{StdIO} = ($inValue eq '-');
            *$obj->{FH} = IO::File->new( "$mode $inValue" )
                or return $obj->saveErrorString(undef, "cannot open file '$inValue': $!", $!) ;
        }

        *$obj->{LineNo} = $. = 0;
        setBinModeInput(*$obj->{FH}) ;

        my $buff = "" ;
        *$obj->{Buffer} = \$buff ;
    }

#    if ($got->getValue('decode')) {
#        my $want_encoding = $got->getValue('decode');
#        *$obj->{Encoding} = IO::Compress::Base::Common::getEncoding($obj, $class, $want_encoding);
#    }
#    else {
#        *$obj->{Encoding} = undef;
#    }

    *$obj->{InputLength}       = $got->parsed('inputlength')
                                    ? $got->getValue('inputlength')
                                    : undef ;
    *$obj->{InputLengthRemaining} = $got->getValue('inputlength');
    *$obj->{BufferOffset}      = 0 ;
    *$obj->{AutoClose}         = $got->getValue('autoclose');
    *$obj->{Strict}            = $got->getValue('strict');
    *$obj->{BlockSize}         = $got->getValue('blocksize');
    *$obj->{Append}            = $got->getValue('append');
    *$obj->{AppendOutput}      = $append_mode || $got->getValue('append');
    *$obj->{ConsumeInput}      = $got->getValue('consumeinput');
    *$obj->{Transparent}       = $got->getValue('transparent');
    *$obj->{MultiStream}       = $got->getValue('multistream');

    # TODO - move these two into RawDeflate
    *$obj->{Scan}              = $got->getValue('scan');
    *$obj->{ParseExtra}        = $got->getValue('parseextra')
                                  || $got->getValue('strict')  ;
    *$obj->{Type}              = '';
    *$obj->{Prime}             = $got->getValue('prime') || '' ;
    *$obj->{Pending}           = '';
    *$obj->{Plain}             = 0;
    *$obj->{PlainBytesRead}    = 0;
    *$obj->{InflatedBytesRead} = 0;
    *$obj->{UnCompSize}        = U64->new;
    *$obj->{CompSize}          = U64->new;
    *$obj->{TotalInflatedBytesRead} = 0;
    *$obj->{NewStream}         = 0 ;
    *$obj->{EventEof}          = 0 ;
    *$obj->{ClassName}         = $class ;
    *$obj->{Params}            = $got ;

    if (*$obj->{ConsumeInput}) {
        *$obj->{InNew} = 0;
        *$obj->{Closed} = 0;
        return $obj
    }

    my $status = $obj->mkUncomp($got);

    return undef
        unless defined $status;

    *$obj->{InNew} = 0;
    *$obj->{Closed} = 0;

    return $obj
        if *$obj->{Pause} ;

    if ($status) {
        # Need to try uncompressing to catch the case
        # where the compressed file uncompresses to an
        # empty string - so eof is set immediately.

        my $out_buffer = '';

        $status = $obj->read(\$out_buffer);

        if ($status < 0) {
            *$obj->{ReadStatus} = [ $status, $obj->error(), $obj->errorNo() ];
        }

        $obj->ungetc($out_buffer)
            if length $out_buffer;
    }
    else {
        return undef
            unless *$obj->{Transparent};

        $obj->clearError();
        *$obj->{Type} = 'plain';
        *$obj->{Plain} = 1;
        $obj->pushBack(*$obj->{HeaderPending})  ;
    }

    push @{ *$obj->{InfoList} }, *$obj->{Info} ;

    $obj->saveStatus(STATUS_OK) ;
    *$obj->{InNew} = 0;
    *$obj->{Closed} = 0;

    return $obj;
}

sub ckInputParam
{
    my $self = shift ;
    my $from = shift ;
    my $inType = whatIsInput($_[0], $_[1]);

    $self->croakError("$from: input parameter not a filename, filehandle, array ref or scalar ref")
        if ! $inType ;

#    if ($inType  eq 'filename' )
#    {
#        return $self->saveErrorString(1, "$from: input filename is undef or null string", STATUS_ERROR)
#            if ! defined $_[0] || $_[0] eq ''  ;
#
#        if ($_[0] ne '-' && ! -e $_[0] )
#        {
#            return $self->saveErrorString(1,
#                            "input file '$_[0]' does not exist", STATUS_ERROR);
#        }
#    }

    return 1;
}


sub _inf
{
    my $obj = shift ;

    my $class = (caller)[0] ;
    my $name = (caller(1))[3] ;

    $obj->croakError("$name: expected at least 1 parameters\n")
        unless @_ >= 1 ;

    my $input = shift ;
    my $haveOut = @_ ;
    my $output = shift ;


    my $x = IO::Compress::Base::Validator->new($class, *$obj->{Error}, $name, $input, $output)
        or return undef ;

    push @_, $output if $haveOut && $x->{Hash};

    *$obj->{OneShot} = 1 ;

    my $got = $obj->checkParams($name, undef, @_)
        or return undef ;

    if ($got->parsed('trailingdata'))
    {
#        my $value = $got->valueRef('TrailingData');
#        warn "TD $value ";
#        #$value = $$value;
##                warn "TD $value $$value ";
#
#        return retErr($obj, "Parameter 'TrailingData' not writable")
#            if readonly $$value ;
#
#        if (ref $$value)
#        {
#            return retErr($obj,"Parameter 'TrailingData' not a scalar reference")
#                if ref $$value ne 'SCALAR' ;
#
#            *$obj->{TrailingData} = $$value ;
#        }
#        else
#        {
#            return retErr($obj,"Parameter 'TrailingData' not a scalar")
#                if ref $value ne 'SCALAR' ;
#
#            *$obj->{TrailingData} = $value ;
#        }

        *$obj->{TrailingData} = $got->getValue('trailingdata');
    }

    *$obj->{MultiStream} = $got->getValue('multistream');
    $got->setValue('multistream', 0);

    $x->{Got} = $got ;

#    if ($x->{Hash})
#    {
#        while (my($k, $v) = each %$input)
#        {
#            $v = \$input->{$k}
#                unless defined $v ;
#
#            $obj->_singleTarget($x, $k, $v, @_)
#                or return undef ;
#        }
#
#        return keys %$input ;
#    }

    if ($x->{GlobMap})
    {
        $x->{oneInput} = 1 ;
        foreach my $pair (@{ $x->{Pairs} })
        {
            my ($from, $to) = @$pair ;
            $obj->_singleTarget($x, $from, $to, @_)
                or return undef ;
        }

        return scalar @{ $x->{Pairs} } ;
    }

    if (! $x->{oneOutput} )
    {
        my $inFile = ($x->{inType} eq 'filenames'
                        || $x->{inType} eq 'filename');

        $x->{inType} = $inFile ? 'filename' : 'buffer';

        foreach my $in ($x->{oneInput} ? $input : @$input)
        {
            my $out ;
            $x->{oneInput} = 1 ;

            $obj->_singleTarget($x, $in, $output, @_)
                or return undef ;
        }

        return 1 ;
    }

    # finally the 1 to 1 and n to 1
    return $obj->_singleTarget($x, $input, $output, @_);

    croak "should not be here" ;
}

sub retErr
{
    my $x = shift ;
    my $string = shift ;

    ${ $x->{Error} } = $string ;

    return undef ;
}

sub _singleTarget
{
    my $self      = shift ;
    my $x         = shift ;
    my $input     = shift;
    my $output    = shift;

    my $buff = '';
    $x->{buff} = \$buff ;

    my $fh ;
    if ($x->{outType} eq 'filename') {
        my $mode = '>' ;
        $mode = '>>'
            if $x->{Got}->getValue('append') ;
        $x->{fh} = IO::File->new( "$mode $output" )
            or return retErr($x, "cannot open file '$output': $!") ;
        binmode $x->{fh} ;

    }

    elsif ($x->{outType} eq 'handle') {
        $x->{fh} = $output;
        binmode $x->{fh} ;
        if ($x->{Got}->getValue('append')) {
                seek($x->{fh}, 0, SEEK_END)
                    or return retErr($x, "Cannot seek to end of output filehandle: $!") ;
            }
    }


    elsif ($x->{outType} eq 'buffer' )
    {
        $$output = ''
            unless $x->{Got}->getValue('append');
        $x->{buff} = $output ;
    }

    if ($x->{oneInput})
    {
        defined $self->_rd2($x, $input, $output)
            or return undef;
    }
    else
    {
        for my $element ( ($x->{inType} eq 'hash') ? keys %$input : @$input)
        {
            defined $self->_rd2($x, $element, $output)
                or return undef ;
        }
    }


    if ( ($x->{outType} eq 'filename' && $output ne '-') ||
         ($x->{outType} eq 'handle' && $x->{Got}->getValue('autoclose'))) {
        $x->{fh}->close()
            or return retErr($x, $!);
        delete $x->{fh};
    }

    return 1 ;
}

sub _rd2
{
    my $self      = shift ;
    my $x         = shift ;
    my $input     = shift;
    my $output    = shift;

    my $z = IO::Compress::Base::Common::createSelfTiedObject($x->{Class}, *$self->{Error});

    $z->_create($x->{Got}, 1, $input, @_)
        or return undef ;

    my $status ;
    my $fh = $x->{fh};

    while (1) {

        while (($status = $z->read($x->{buff})) > 0) {
            if ($fh) {
                local $\;
                print $fh ${ $x->{buff} }
                    or return $z->saveErrorString(undef, "Error writing to output file: $!", $!);
                ${ $x->{buff} } = '' ;
            }
        }

        if (! $x->{oneOutput} ) {
            my $ot = $x->{outType} ;

            if ($ot eq 'array')
              { push @$output, $x->{buff} }
            elsif ($ot eq 'hash')
              { $output->{$input} = $x->{buff} }

            my $buff = '';
            $x->{buff} = \$buff;
        }

        last if $status < 0 || $z->smartEof();

        last
            unless *$self->{MultiStream};

        $status = $z->nextStream();

        last
            unless $status == 1 ;
    }

    return $z->closeError(undef)
        if $status < 0 ;

    ${ *$self->{TrailingData} } = $z->trailingData()
        if defined *$self->{TrailingData} ;

    $z->close()
        or return undef ;

    return 1 ;
}

sub TIEHANDLE
{
    return $_[0] if ref($_[0]);
    die "OOPS\n" ;

}

sub UNTIE
{
    my $self = shift ;
}


sub getHeaderInfo
{
    my $self = shift ;
    wantarray ? @{ *$self->{InfoList} } : *$self->{Info};
}

sub readBlock
{
    my $self = shift ;
    my $buff = shift ;
    my $size = shift ;

    if (defined *$self->{CompressedInputLength}) {
        if (*$self->{CompressedInputLengthRemaining} == 0) {
            delete *$self->{CompressedInputLength};
            *$self->{CompressedInputLengthDone} = 1;
            return STATUS_OK ;
        }
        $size = List::Util::min($size, *$self->{CompressedInputLengthRemaining} );
        *$self->{CompressedInputLengthRemaining} -= $size ;
    }

    my $status = $self->smartRead($buff, $size) ;
    return $self->saveErrorString(STATUS_ERROR, "Error Reading Data: $!", $!)
        if $status == STATUS_ERROR  ;

    if ($status == 0 ) {
        *$self->{Closed} = 1 ;
        *$self->{EndStream} = 1 ;
        return $self->saveErrorString(STATUS_ERROR, "unexpected end of file", STATUS_ERROR);
    }

    return STATUS_OK;
}

sub postBlockChk
{
    return STATUS_OK;
}

sub _raw_read
{
    # return codes
    # >0 - ok, number of bytes read
    # =0 - ok, eof
    # <0 - not ok

    my $self = shift ;

    return G_EOF if *$self->{Closed} ;
    return G_EOF if *$self->{EndStream} ;

    my $buffer = shift ;
    my $scan_mode = shift ;

    if (*$self->{Plain}) {
        my $tmp_buff ;
        my $len = $self->smartRead(\$tmp_buff, *$self->{BlockSize}) ;

        return $self->saveErrorString(G_ERR, "Error reading data: $!", $!)
                if $len == STATUS_ERROR ;

        if ($len == 0 ) {
            *$self->{EndStream} = 1 ;
        }
        else {
            *$self->{PlainBytesRead} += $len ;
            $$buffer .= $tmp_buff;
        }

        return $len ;
    }

    if (*$self->{NewStream}) {

        $self->gotoNextStream() > 0
            or return G_ERR;

        # For the headers that actually uncompressed data, put the
        # uncompressed data into the output buffer.
        $$buffer .=  *$self->{Pending} ;
        my $len = length  *$self->{Pending} ;
        *$self->{Pending} = '';
        return $len;
    }

    my $temp_buf = '';
    my $outSize = 0;
    my $status = $self->readBlock(\$temp_buf, *$self->{BlockSize}, $outSize) ;

    return G_ERR
        if $status == STATUS_ERROR  ;

    my $buf_len = 0;
    if ($status == STATUS_OK) {
        my $beforeC_len = length $temp_buf;
        my $before_len = defined $$buffer ? length $$buffer : 0 ;
        $status = *$self->{Uncomp}->uncompr(\$temp_buf, $buffer,
                                    defined *$self->{CompressedInputLengthDone} ||
                                                $self->smartEof(), $outSize);

        # Remember the input buffer if it wasn't consumed completely
        $self->pushBack($temp_buf) if *$self->{Uncomp}{ConsumesInput};

        return $self->saveErrorString(G_ERR, *$self->{Uncomp}{Error}, *$self->{Uncomp}{ErrorNo})
            if $self->saveStatus($status) == STATUS_ERROR;

        $self->postBlockChk($buffer, $before_len) == STATUS_OK
            or return G_ERR;

        $buf_len = defined $$buffer ? length($$buffer) - $before_len : 0;

        *$self->{CompSize}->add($beforeC_len - length $temp_buf) ;

        *$self->{InflatedBytesRead} += $buf_len ;
        *$self->{TotalInflatedBytesRead} += $buf_len ;
        *$self->{UnCompSize}->add($buf_len) ;

        $self->filterUncompressed($buffer, $before_len);

#        if (*$self->{Encoding}) {
#            use Encode ;
#            *$self->{PendingDecode} .= substr($$buffer, $before_len) ;
#            my $got = *$self->{Encoding}->decode(*$self->{PendingDecode}, Encode::FB_QUIET) ;
#            substr($$buffer, $before_len) = $got;
#        }
    }

    if ($status == STATUS_ENDSTREAM) {

        *$self->{EndStream} = 1 ;

        my $trailer;
        my $trailer_size = *$self->{Info}{TrailerLength} ;
        my $got = 0;
        if (*$self->{Info}{TrailerLength})
        {
            $got = $self->smartRead(\$trailer, $trailer_size) ;
        }

        if ($got == $trailer_size) {
            $self->chkTrailer($trailer) == STATUS_OK
                or return G_ERR;
        }
        else {
            return $self->TrailerError("trailer truncated. Expected " .
                                      "$trailer_size bytes, got $got")
                if *$self->{Strict};
            $self->pushBack($trailer)  ;
        }

        # TODO - if want file pointer, do it here

        if (! $self->smartEof()) {
            *$self->{NewStream} = 1 ;

            if (*$self->{MultiStream}) {
                *$self->{EndStream} = 0 ;
                return $buf_len ;
            }
        }

    }


    # return the number of uncompressed bytes read
    return $buf_len ;
}

sub reset
{
    my $self = shift ;

    return *$self->{Uncomp}->reset();
}

sub filterUncompressed
{
}

#sub isEndStream
#{
#    my $self = shift ;
#    return *$self->{NewStream} ||
#           *$self->{EndStream} ;
#}

sub nextStream
{
    my $self = shift ;

    my $status = $self->gotoNextStream();
    $status == 1
        or return $status ;

    *$self->{Pending} = ''
        if $self !~ /IO::Uncompress::RawInflate/ && ! *$self->{MultiStream};

    *$self->{TotalInflatedBytesRead} = 0 ;
    *$self->{LineNo} = $. = 0;

    return 1;
}

sub gotoNextStream
{
    my $self = shift ;

    if (! *$self->{NewStream}) {
        my $status = 1;
        my $buffer ;

        # TODO - make this more efficient if know the offset for the end of
        # the stream and seekable
        $status = $self->read($buffer)
            while $status > 0 ;

        return $status
            if $status < 0;
    }

    *$self->{NewStream} = 0 ;
    *$self->{EndStream} = 0 ;
    *$self->{CompressedInputLengthDone} = undef ;
    *$self->{CompressedInputLength} = undef ;
    $self->reset();
    *$self->{UnCompSize}->reset();
    *$self->{CompSize}->reset();

    my $magic = $self->ckMagic();

    if ( ! defined $magic) {
        if (! *$self->{Transparent} || $self->eof())
        {
            *$self->{EndStream} = 1 ;
            return 0;
        }

        # Not EOF, so Transparent mode kicks in now for trailing data
        # Reset member name in case anyone calls getHeaderInfo()->{Name}
        *$self->{Info} = { Name => undef, Type  => 'plain' };

        $self->clearError();
        *$self->{Type} = 'plain';
        *$self->{Plain} = 1;
        $self->pushBack(*$self->{HeaderPending})  ;
    }
    else
    {
        *$self->{Info} = $self->readHeader($magic);

        if ( ! defined *$self->{Info} ) {
            *$self->{EndStream} = 1 ;
            return -1;
        }
    }

    push @{ *$self->{InfoList} }, *$self->{Info} ;

    return 1;
}

sub streamCount
{
    my $self = shift ;
    return 1 if ! defined *$self->{InfoList};
    return scalar @{ *$self->{InfoList} }  ;
}

sub read
{
    # return codes
    # >0 - ok, number of bytes read
    # =0 - ok, eof
    # <0 - not ok

    my $self = shift ;

    if (defined *$self->{ReadStatus} ) {
        my $status = *$self->{ReadStatus}[0];
        $self->saveErrorString( @{ *$self->{ReadStatus} } );
        delete  *$self->{ReadStatus} ;
        return $status ;
    }

    return G_EOF if *$self->{Closed} ;

    my $buffer ;

    if (ref $_[0] ) {
        $self->croakError(*$self->{ClassName} . "::read: buffer parameter is read-only")
            if Scalar::Util::readonly(${ $_[0] });

        $self->croakError(*$self->{ClassName} . "::read: not a scalar reference $_[0]" )
            unless ref $_[0] eq 'SCALAR' ;
        $buffer = $_[0] ;
    }
    else {
        $self->croakError(*$self->{ClassName} . "::read: buffer parameter is read-only")
            if Scalar::Util::readonly($_[0]);

        $buffer = \$_[0] ;
    }

    my $length = $_[1] ;
    my $offset = $_[2] || 0;

    if (! *$self->{AppendOutput}) {
        if (! $offset) {

            $$buffer = '' ;
        }
        else {
            if ($offset > length($$buffer)) {
                $$buffer .= "\x00" x ($offset - length($$buffer));
            }
            else {
                substr($$buffer, $offset) = '';
            }
        }
    }
    elsif (! defined $$buffer) {
        $$buffer = '' ;
    }

    return G_EOF if !length *$self->{Pending} && *$self->{EndStream} ;

    # the core read will return 0 if asked for 0 bytes
    return 0 if defined $length && $length == 0 ;

    $length = $length || 0;

    $self->croakError(*$self->{ClassName} . "::read: length parameter is negative")
        if $length < 0 ;

    # Short-circuit if this is a simple read, with no length
    # or offset specified.
    unless ( $length || $offset) {
        if (length *$self->{Pending}) {
            $$buffer .= *$self->{Pending} ;
            my $len = length *$self->{Pending};
            *$self->{Pending} = '' ;
            return $len ;
        }
        else {
            my $len = 0;
            $len = $self->_raw_read($buffer)
                while ! *$self->{EndStream} && $len == 0 ;
            return $len ;
        }
    }

    # Need to jump through more hoops - either length or offset
    # or both are specified.
    my $out_buffer = *$self->{Pending} ;
    *$self->{Pending} = '';


    while (! *$self->{EndStream} && length($out_buffer) < $length)
    {
        my $buf_len = $self->_raw_read(\$out_buffer);
        return $buf_len
            if $buf_len < 0 ;
    }

    $length = length $out_buffer
        if length($out_buffer) < $length ;

    return 0
        if $length == 0 ;

    $$buffer = ''
        if ! defined $$buffer;

    $offset = length $$buffer
        if *$self->{AppendOutput} ;

    *$self->{Pending} = $out_buffer;
    $out_buffer = \*$self->{Pending} ;

    substr($$buffer, $offset) = substr($$out_buffer, 0, $length) ;
    substr($$out_buffer, 0, $length) =  '' ;

    return $length ;
}

sub _getline
{
    my $self = shift ;
    my $status = 0 ;

    # Slurp Mode
    if ( ! defined $/ ) {
        my $data ;
        1 while ($status = $self->read($data)) > 0 ;
        return ($status, \$data);
    }

    # Record Mode
    if ( ref $/ eq 'SCALAR' && ${$/} =~ /^\d+$/ && ${$/} > 0) {
        my $reclen = ${$/} ;
        my $data ;
        $status = $self->read($data, $reclen) ;
        return ($status, \$data);
    }

    # Paragraph Mode
    if ( ! length $/ ) {
        my $paragraph ;
        while (($status = $self->read($paragraph)) > 0 ) {
            if ($paragraph =~ s/^(.*?\n\n+)//s) {
                *$self->{Pending}  = $paragraph ;
                my $par = $1 ;
                return (1, \$par);
            }
        }
        return ($status, \$paragraph);
    }

    # $/ isn't empty, or a reference, so it's Line Mode.
    {
        my $line ;
        my $p = \*$self->{Pending}  ;
        while (($status = $self->read($line)) > 0 ) {
            my $offset = index($line, $/);
            if ($offset >= 0) {
                my $l = substr($line, 0, $offset + length $/ );
                substr($line, 0, $offset + length $/) = '';
                $$p = $line;
                return (1, \$l);
            }
        }

        return ($status, \$line);
    }
}

sub getline
{
    my $self = shift;

    if (defined *$self->{ReadStatus} ) {
        $self->saveErrorString( @{ *$self->{ReadStatus} } );
        delete  *$self->{ReadStatus} ;
        return undef;
    }

    return undef
        if *$self->{Closed} || (!length *$self->{Pending} && *$self->{EndStream}) ;

    my $current_append = *$self->{AppendOutput} ;
    *$self->{AppendOutput} = 1;

    my ($status, $lineref) = $self->_getline();
    *$self->{AppendOutput} = $current_append;

    return undef
        if $status < 0 || length $$lineref == 0 ;

    $. = ++ *$self->{LineNo} ;

    return $$lineref ;
}

sub getlines
{
    my $self = shift;
    $self->croakError(*$self->{ClassName} .
            "::getlines: called in scalar context\n") unless wantarray;
    my($line, @lines);
    push(@lines, $line)
        while defined($line = $self->getline);
    return @lines;
}

sub READLINE
{
    goto &getlines if wantarray;
    goto &getline;
}

sub getc
{
    my $self = shift;
    my $buf;
    return $buf if $self->read($buf, 1);
    return undef;
}

sub ungetc
{
    my $self = shift;
    *$self->{Pending} = ""  unless defined *$self->{Pending} ;
    *$self->{Pending} = $_[0] . *$self->{Pending} ;
}


sub trailingData
{
    my $self = shift ;

    if (defined *$self->{FH} || defined *$self->{InputEvent} ) {
        return *$self->{Prime} ;
    }
    else {
        my $buf = *$self->{Buffer} ;
        my $offset = *$self->{BufferOffset} ;
        return substr($$buf, $offset) ;
    }
}


sub eof
{
    my $self = shift ;

    return (*$self->{Closed} ||
              (!length *$self->{Pending}
                && ( $self->smartEof() || *$self->{EndStream}))) ;
}

sub tell
{
    my $self = shift ;

    my $in ;
    if (*$self->{Plain}) {
        $in = *$self->{PlainBytesRead} ;
    }
    else {
        $in = *$self->{TotalInflatedBytesRead} ;
    }

    my $pending = length *$self->{Pending} ;

    return 0 if $pending > $in ;
    return $in - $pending ;
}

sub close
{
    # todo - what to do if close is called before the end of the gzip file
    #        do we remember any trailing data?
    my $self = shift ;

    return 1 if *$self->{Closed} ;

    untie *$self
        if $] >= 5.008 ;

    my $status = 1 ;

    if (defined *$self->{FH}) {
        if ((! *$self->{Handle} || *$self->{AutoClose}) && ! *$self->{StdIO}) {
            local $.;
            $! = 0 ;
            $status = *$self->{FH}->close();
            return $self->saveErrorString(0, $!, $!)
                if !*$self->{InNew} && $self->saveStatus($!) != 0 ;
        }
        delete *$self->{FH} ;
        $! = 0 ;
    }
    *$self->{Closed} = 1 ;

    return 1;
}

sub DESTROY
{
    my $self = shift ;
    local ($., $@, $!, $^E, $?);

    $self->close() ;
}

sub seek
{
    my $self     = shift ;
    my $position = shift;
    my $whence   = shift ;

    my $here = $self->tell() ;
    my $target = 0 ;


    if ($whence == SEEK_SET) {
        $target = $position ;
    }
    elsif ($whence == SEEK_CUR) {
        $target = $here + $position ;
    }
    elsif ($whence == SEEK_END) {
        $target = $position ;
        $self->croakError(*$self->{ClassName} . "::seek: SEEK_END not allowed") ;
    }
    else {
        $self->croakError(*$self->{ClassName} ."::seek: unknown value, $whence, for whence parameter");
    }

    # short circuit if seeking to current offset
    if ($target == $here) {
        # On ordinary filehandles, seeking to the current
        # position also clears the EOF condition, so we
        # emulate this behavior locally while simultaneously
        # cascading it to the underlying filehandle
        if (*$self->{Plain}) {
            *$self->{EndStream} = 0;
            seek(*$self->{FH},0,1) if *$self->{FH};
        }
        return 1;
    }

    # Outlaw any attempt to seek backwards
    $self->croakError( *$self->{ClassName} ."::seek: cannot seek backwards")
        if $target < $here ;

    # Walk the file to the new offset
    my $offset = $target - $here ;

    my $got;
    while (($got = $self->read(my $buffer, List::Util::min($offset, *$self->{BlockSize})) ) > 0)
    {
        $offset -= $got;
        last if $offset == 0 ;
    }

    $here = $self->tell() ;
    return $offset == 0 ? 1 : 0 ;
}

sub fileno
{
    my $self = shift ;
    return defined *$self->{FH}
           ? fileno *$self->{FH}
           : undef ;
}

sub binmode
{
    1;
#    my $self     = shift ;
#    return defined *$self->{FH}
#            ? binmode *$self->{FH}
#            : 1 ;
}

sub opened
{
    my $self     = shift ;
    return ! *$self->{Closed} ;
}

sub autoflush
{
    my $self     = shift ;
    return defined *$self->{FH}
            ? *$self->{FH}->autoflush(@_)
            : undef ;
}

sub input_line_number
{
    my $self = shift ;
    my $last = *$self->{LineNo};
    $. = *$self->{LineNo} = $_[1] if @_ ;
    return $last;
}

sub _notAvailable
{
    my $name = shift ;
    return sub { croak "$name Not Available: File opened only for intput" ; } ;
}

{
    no warnings 'once';

    *BINMODE  = \&binmode;
    *SEEK     = \&seek;
    *READ     = \&read;
    *sysread  = \&read;
    *TELL     = \&tell;
    *EOF      = \&eof;

    *FILENO   = \&fileno;
    *CLOSE    = \&close;

    *print    = _notAvailable('print');
    *PRINT    = _notAvailable('print');
    *printf   = _notAvailable('printf');
    *PRINTF   = _notAvailable('printf');
    *write    = _notAvailable('write');
    *WRITE    = _notAvailable('write');

    #*sysread  = \&read;
    #*syswrite = \&_notAvailable;
}



package IO::Uncompress::Base ;


1 ;
__END__

=head1 NAME

IO::Uncompress::Base - Base Class for IO::Uncompress modules

=head1 SYNOPSIS

    use IO::Uncompress::Base ;

=head1 DESCRIPTION

This module is not intended for direct use in application code. Its sole
purpose is to be sub-classed by IO::Uncompress modules.

=head1 SUPPORT

General feedback/questions/bug reports should be sent to
L<https://github.com/pmqs/IO-Compress/issues> (preferred) or
L<https://rt.cpan.org/Public/Dist/Display.html?Name=IO-Compress>.

=head1 SEE ALSO

L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzip>, L<IO::Uncompress::UnLzip>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Compress::Zstd>, L<IO::Uncompress::UnZstd>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>

L<IO::Compress::FAQ|IO::Compress::FAQ>

L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>,
L<Archive::Tar|Archive::Tar>,
L<IO::Zlib|IO::Zlib>

=head1 AUTHOR

This module was written by Paul Marquess, C<pmqs@cpan.org>.

=head1 MODIFICATION HISTORY

See the Changes file.

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2005-2021 Paul Marquess. All rights reserved.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
                                                               Scalar.pm                                                                                           0000644                 00000032510 00000000000 0006251 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       package Test::Builder::IO::Scalar;


=head1 NAME

Test::Builder::IO::Scalar - A copy of IO::Scalar for Test::Builder

=head1 DESCRIPTION

This is a copy of L<IO::Scalar> which ships with L<Test::Builder> to
support scalar references as filehandles on Perl 5.6.  Newer
versions of Perl simply use C<open()>'s built in support.

L<Test::Builder> can not have dependencies on other modules without
careful consideration, so its simply been copied into the distribution.

=head1 COPYRIGHT and LICENSE

This file came from the "IO-stringy" Perl5 toolkit.

Copyright (c) 1996 by Eryq.  All rights reserved.
Copyright (c) 1999,2001 by ZeeGee Software Inc.  All rights reserved.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.


=cut

# This is copied code, I don't care.
##no critic

use Carp;
use strict;
use vars qw($VERSION @ISA);
use IO::Handle;

use 5.005;

### The package version, both in 1.23 style *and* usable by MakeMaker:
$VERSION = "2.114";

### Inheritance:
@ISA = qw(IO::Handle);

#==============================

=head2 Construction

=over 4

=cut

#------------------------------

=item new [ARGS...]

I<Class method.>
Return a new, unattached scalar handle.
If any arguments are given, they're sent to open().

=cut

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = bless \do { local *FH }, $class;
    tie *$self, $class, $self;
    $self->open(@_);   ### open on anonymous by default
    $self;
}
sub DESTROY {
    shift->close;
}

#------------------------------

=item open [SCALARREF]

I<Instance method.>
Open the scalar handle on a new scalar, pointed to by SCALARREF.
If no SCALARREF is given, a "private" scalar is created to hold
the file data.

Returns the self object on success, undefined on error.

=cut

sub open {
    my ($self, $sref) = @_;

    ### Sanity:
    defined($sref) or do {my $s = ''; $sref = \$s};
    (ref($sref) eq "SCALAR") or croak "open() needs a ref to a scalar";

    ### Setup:
    *$self->{Pos} = 0;          ### seek position
    *$self->{SR}  = $sref;      ### scalar reference
    $self;
}

#------------------------------

=item opened

I<Instance method.>
Is the scalar handle opened on something?

=cut

sub opened {
    *{shift()}->{SR};
}

#------------------------------

=item close

I<Instance method.>
Disassociate the scalar handle from its underlying scalar.
Done automatically on destroy.

=cut

sub close {
    my $self = shift;
    %{*$self} = ();
    1;
}

=back

=cut



#==============================

=head2 Input and output

=over 4

=cut


#------------------------------

=item flush

I<Instance method.>
No-op, provided for OO compatibility.

=cut

sub flush { "0 but true" }

#------------------------------

=item getc

I<Instance method.>
Return the next character, or undef if none remain.

=cut

sub getc {
    my $self = shift;

    ### Return undef right away if at EOF; else, move pos forward:
    return undef if $self->eof;
    substr(${*$self->{SR}}, *$self->{Pos}++, 1);
}

#------------------------------

=item getline

I<Instance method.>
Return the next line, or undef on end of string.
Can safely be called in an array context.
Currently, lines are delimited by "\n".

=cut

sub getline {
    my $self = shift;

    ### Return undef right away if at EOF:
    return undef if $self->eof;

    ### Get next line:
    my $sr = *$self->{SR};
    my $i  = *$self->{Pos};	        ### Start matching at this point.

    ### Minimal impact implementation!
    ### We do the fast fast thing (no regexps) if using the
    ### classic input record separator.

    ### Case 1: $/ is undef: slurp all...
    if    (!defined($/)) {
	*$self->{Pos} = length $$sr;
        return substr($$sr, $i);
    }

    ### Case 2: $/ is "\n": zoom zoom zoom...
    elsif ($/ eq "\012") {

        ### Seek ahead for "\n"... yes, this really is faster than regexps.
        my $len = length($$sr);
        for (; $i < $len; ++$i) {
           last if ord (substr ($$sr, $i, 1)) == 10;
        }

        ### Extract the line:
        my $line;
        if ($i < $len) {                ### We found a "\n":
            $line = substr ($$sr, *$self->{Pos}, $i - *$self->{Pos} + 1);
            *$self->{Pos} = $i+1;            ### Remember where we finished up.
        }
        else {                          ### No "\n"; slurp the remainder:
            $line = substr ($$sr, *$self->{Pos}, $i - *$self->{Pos});
            *$self->{Pos} = $len;
        }
        return $line;
    }

    ### Case 3: $/ is ref to int. Do fixed-size records.
    ###        (Thanks to Dominique Quatravaux.)
    elsif (ref($/)) {
        my $len = length($$sr);
		my $i = ${$/} + 0;
		my $line = substr ($$sr, *$self->{Pos}, $i);
		*$self->{Pos} += $i;
        *$self->{Pos} = $len if (*$self->{Pos} > $len);
		return $line;
    }

    ### Case 4: $/ is either "" (paragraphs) or something weird...
    ###         This is Graham's general-purpose stuff, which might be
    ###         a tad slower than Case 2 for typical data, because
    ###         of the regexps.
    else {
        pos($$sr) = $i;

	### If in paragraph mode, skip leading lines (and update i!):
        length($/) or
	    (($$sr =~ m/\G\n*/g) and ($i = pos($$sr)));

        ### If we see the separator in the buffer ahead...
        if (length($/)
	    ?  $$sr =~ m,\Q$/\E,g          ###   (ordinary sep) TBD: precomp!
            :  $$sr =~ m,\n\n,g            ###   (a paragraph)
            ) {
            *$self->{Pos} = pos $$sr;
            return substr($$sr, $i, *$self->{Pos}-$i);
        }
        ### Else if no separator remains, just slurp the rest:
        else {
            *$self->{Pos} = length $$sr;
            return substr($$sr, $i);
        }
    }
}

#------------------------------

=item getlines

I<Instance method.>
Get all remaining lines.
It will croak() if accidentally called in a scalar context.

=cut

sub getlines {
    my $self = shift;
    wantarray or croak("can't call getlines in scalar context!");
    my ($line, @lines);
    push @lines, $line while (defined($line = $self->getline));
    @lines;
}

#------------------------------

=item print ARGS...

I<Instance method.>
Print ARGS to the underlying scalar.

B<Warning:> this continues to always cause a seek to the end
of the string, but if you perform seek()s and tell()s, it is
still safer to explicitly seek-to-end before subsequent print()s.

=cut

sub print {
    my $self = shift;
    *$self->{Pos} = length(${*$self->{SR}} .= join('', @_) . (defined($\) ? $\ : ""));
    1;
}
sub _unsafe_print {
    my $self = shift;
    my $append = join('', @_) . $\;
    ${*$self->{SR}} .= $append;
    *$self->{Pos}   += length($append);
    1;
}
sub _old_print {
    my $self = shift;
    ${*$self->{SR}} .= join('', @_) . $\;
    *$self->{Pos} = length(${*$self->{SR}});
    1;
}


#------------------------------

=item read BUF, NBYTES, [OFFSET]

I<Instance method.>
Read some bytes from the scalar.
Returns the number of bytes actually read, 0 on end-of-file, undef on error.

=cut

sub read {
    my $self = $_[0];
    my $n    = $_[2];
    my $off  = $_[3] || 0;

    my $read = substr(${*$self->{SR}}, *$self->{Pos}, $n);
    $n = length($read);
    *$self->{Pos} += $n;
    ($off ? substr($_[1], $off) : $_[1]) = $read;
    return $n;
}

#------------------------------

=item write BUF, NBYTES, [OFFSET]

I<Instance method.>
Write some bytes to the scalar.

=cut

sub write {
    my $self = $_[0];
    my $n    = $_[2];
    my $off  = $_[3] || 0;

    my $data = substr($_[1], $off, $n);
    $n = length($data);
    $self->print($data);
    return $n;
}

#------------------------------

=item sysread BUF, LEN, [OFFSET]

I<Instance method.>
Read some bytes from the scalar.
Returns the number of bytes actually read, 0 on end-of-file, undef on error.

=cut

sub sysread {
  my $self = shift;
  $self->read(@_);
}

#------------------------------

=item syswrite BUF, NBYTES, [OFFSET]

I<Instance method.>
Write some bytes to the scalar.

=cut

sub syswrite {
  my $self = shift;
  $self->write(@_);
}

=back

=cut


#==============================

=head2 Seeking/telling and other attributes

=over 4

=cut


#------------------------------

=item autoflush

I<Instance method.>
No-op, provided for OO compatibility.

=cut

sub autoflush {}

#------------------------------

=item binmode

I<Instance method.>
No-op, provided for OO compatibility.

=cut

sub binmode {}

#------------------------------

=item clearerr

I<Instance method.>  Clear the error and EOF flags.  A no-op.

=cut

sub clearerr { 1 }

#------------------------------

=item eof

I<Instance method.>  Are we at end of file?

=cut

sub eof {
    my $self = shift;
    (*$self->{Pos} >= length(${*$self->{SR}}));
}

#------------------------------

=item seek OFFSET, WHENCE

I<Instance method.>  Seek to a given position in the stream.

=cut

sub seek {
    my ($self, $pos, $whence) = @_;
    my $eofpos = length(${*$self->{SR}});

    ### Seek:
    if    ($whence == 0) { *$self->{Pos} = $pos }             ### SEEK_SET
    elsif ($whence == 1) { *$self->{Pos} += $pos }            ### SEEK_CUR
    elsif ($whence == 2) { *$self->{Pos} = $eofpos + $pos}    ### SEEK_END
    else                 { croak "bad seek whence ($whence)" }

    ### Fixup:
    if (*$self->{Pos} < 0)       { *$self->{Pos} = 0 }
    if (*$self->{Pos} > $eofpos) { *$self->{Pos} = $eofpos }
    return 1;
}

#------------------------------

=item sysseek OFFSET, WHENCE

I<Instance method.> Identical to C<seek OFFSET, WHENCE>, I<q.v.>

=cut

sub sysseek {
    my $self = shift;
    $self->seek (@_);
}

#------------------------------

=item tell

I<Instance method.>
Return the current position in the stream, as a numeric offset.

=cut

sub tell { *{shift()}->{Pos} }

#------------------------------

=item  use_RS [YESNO]

I<Instance method.>
B<Deprecated and ignored.>
Obey the current setting of $/, like IO::Handle does?
Default is false in 1.x, but cold-welded true in 2.x and later.

=cut

sub use_RS {
    my ($self, $yesno) = @_;
    carp "use_RS is deprecated and ignored; \$/ is always consulted\n";
 }

#------------------------------

=item setpos POS

I<Instance method.>
Set the current position, using the opaque value returned by C<getpos()>.

=cut

sub setpos { shift->seek($_[0],0) }

#------------------------------

=item getpos

I<Instance method.>
Return the current position in the string, as an opaque object.

=cut

*getpos = \&tell;


#------------------------------

=item sref

I<Instance method.>
Return a reference to the underlying scalar.

=cut

sub sref { *{shift()}->{SR} }


#------------------------------
# Tied handle methods...
#------------------------------

# Conventional tiehandle interface:
sub TIEHANDLE {
    ((defined($_[1]) && UNIVERSAL::isa($_[1], __PACKAGE__))
     ? $_[1]
     : shift->new(@_));
}
sub GETC      { shift->getc(@_) }
sub PRINT     { shift->print(@_) }
sub PRINTF    { shift->print(sprintf(shift, @_)) }
sub READ      { shift->read(@_) }
sub READLINE  { wantarray ? shift->getlines(@_) : shift->getline(@_) }
sub WRITE     { shift->write(@_); }
sub CLOSE     { shift->close(@_); }
sub SEEK      { shift->seek(@_); }
sub TELL      { shift->tell(@_); }
sub EOF       { shift->eof(@_); }
sub FILENO    { -1 }

#------------------------------------------------------------

1;

__END__



=back

=cut


=head1 WARNINGS

Perl's TIEHANDLE spec was incomplete prior to 5.005_57;
it was missing support for C<seek()>, C<tell()>, and C<eof()>.
Attempting to use these functions with an IO::Scalar will not work
prior to 5.005_57. IO::Scalar will not have the relevant methods
invoked; and even worse, this kind of bug can lie dormant for a while.
If you turn warnings on (via C<$^W> or C<perl -w>),
and you see something like this...

    attempt to seek on unopened filehandle

...then you are probably trying to use one of these functions
on an IO::Scalar with an old Perl.  The remedy is to simply
use the OO version; e.g.:

    $SH->seek(0,0);    ### GOOD: will work on any 5.005
    seek($SH,0,0);     ### WARNING: will only work on 5.005_57 and beyond


=head1 VERSION

$Id: Scalar.pm,v 1.6 2005/02/10 21:21:53 dfs Exp $


=head1 AUTHORS

=head2 Primary Maintainer

David F. Skoll (F<dfs@roaringpenguin.com>).

=head2 Principal author

Eryq (F<eryq@zeegee.com>).
President, ZeeGee Software Inc (F<http://www.zeegee.com>).


=head2 Other contributors

The full set of contributors always includes the folks mentioned
in L<IO::Stringy/"CHANGE LOG">.  But just the same, special
thanks to the following individuals for their invaluable contributions
(if I've forgotten or misspelled your name, please email me!):

I<Andy Glew,>
for contributing C<getc()>.

I<Brandon Browning,>
for suggesting C<opened()>.

I<David Richter,>
for finding and fixing the bug in C<PRINTF()>.

I<Eric L. Brine,>
for his offset-using read() and write() implementations.

I<Richard Jones,>
for his patches to massively improve the performance of C<getline()>
and add C<sysread> and C<syswrite>.

I<B. K. Oxley (binkley),>
for stringification and inheritance improvements,
and sundry good ideas.

I<Doug Wilson,>
for the IO::Handle inheritance and automatic tie-ing.


=head1 SEE ALSO

L<IO::String>, which is quite similar but which was designed
more-recently and with an IO::Handle-like interface in mind,
so you could mix OO- and native-filehandle usage without using tied().

I<Note:> as of version 2.x, these classes all work like
their IO::Handle counterparts, so we have comparable
functionality to IO::String.

=cut

                                                                                                                                                                                        InputStream.php                                                                                     0000755                 00000002701 00000000000 0007474 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       <?php
/**
 * Copyright Amazon.com, Inc. or its affiliates. All Rights Reserved.
 * SPDX-License-Identifier: Apache-2.0.
 */
namespace AWS\CRT\IO;

use AWS\CRT\NativeResource as NativeResource;

final class InputStream extends NativeResource {
    private $stream = null;

    const SEEK_BEGIN = 0;
    const SEEK_END = 2;

    public function __construct($stream) {
        parent::__construct();
        $this->stream = $stream;
        $options = self::$crt->input_stream_options_new();
        // The stream implementation in native just converts the PHP stream into
        // a native php_stream* and executes operations entirely in native
        self::$crt->input_stream_options_set_user_data($options, $stream);
        $this->acquire(self::$crt->input_stream_new($options));
        self::$crt->input_stream_options_release($options);
    }

    public function __destruct() {
        $this->release();
        parent::__destruct();
    }

    public function eof() {
        return self::$crt->input_stream_eof($this->native);
    }

    public function length() {
        return self::$crt->input_stream_get_length($this->native);
    }

    public function read($length = 0) {
        if ($length == 0) {
            $length = $this->length();
        }
        return self::$crt->input_stream_read($this->native, $length);
    }

    public function seek($offset, $basis) {
        return self::$crt->input_stream_seek($this->native, $offset, $basis);
    }
}
                                                               EventLoopGroup.php                                                                                  0000755                 00000002347 00000000000 0010157 0                                                                                                    ustar 00                                                                                                                                                                                                                                                       <?php
/**
 * Copyright Amazon.com, Inc. or its affiliates. All Rights Reserved.
 * SPDX-License-Identifier: Apache-2.0.
 */
namespace AWS\CRT\IO;

use AWS\CRT\NativeResource as NativeResource;
use AWS\CRT\Options as Options;

/**
 * Represents 1 or more event loops (1 per thread) for doing I/O and background tasks.
 * Typically, every application has one EventLoopGroup.
 *
 * @param array options:
 * - int num_threads - Number of worker threads in the EventLoopGroup. Defaults to 0/1 per logical core.
 */
final class EventLoopGroup extends NativeResource {

    static function defaults() {
        return [
            'max_threads' => 0,
        ];
    }

    function __construct(array $options = []) {
        parent::__construct();
        $options = new Options($options, self::defaults());
        $elg_options = self::$crt->event_loop_group_options_new();
        self::$crt->event_loop_group_options_set_max_threads($elg_options, $options->getInt('max_threads'));
        $this->acquire(self::$crt->event_loop_group_new($elg_options));
        self::$crt->event_loop_group_options_release($elg_options);
    }

    function __destruct() {
        self::$crt->event_loop_group_release($this->release());
        parent::__destruct();
    }
}
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      