package Net::Dropbear::SSHd;

use strict;
use v5.12;
our $VERSION = '0.01';

use Child;

use autodie;
use Carp;
use Moo;
use Types::Standard qw/ArrayRef HashRef GlobRef Str Int Bool InstanceOf/;

has addrs => (
  is => 'rw',
  isa => ArrayRef[Str],
  coerce => sub { ref $_[0] ? $_[0] : [ $_[0] ] },
);

has keys => (
  is => 'rw',
  isa => ArrayRef[Str],
  coerce => sub {
    my $value = shift;
    $value = ref $value ? $value : [ $value ];
    foreach my $key ( @$value )
    {
      carp "Key file does not exist: $key"
        if !-e $key;
    }
    return $value;
  },
);

has hooks => (
  is => 'ro',
  isa => HashRef,
  default => sub { {} },
);

has debug          => ( is => "rw", isa => Bool, default => 0, );
has forkbg         => ( is => "rw", isa => Bool, default => 0, );
has usingsyslog    => ( is => "rw", isa => Bool, default => 0, );
has inetdmode      => ( is => "rw", isa => Bool, default => 0, );
has norootlogin    => ( is => "rw", isa => Bool, default => 1, );
has noauthpass     => ( is => "rw", isa => Bool, default => 1, );
has norootpass     => ( is => "rw", isa => Bool, default => 1, );
has allowblankpass => ( is => "rw", isa => Bool, default => 0, );
has delay_hostkey  => ( is => "rw", isa => Bool, default => 0, );
has domotd         => ( is => "rw", isa => Bool, default => 0, );
has noremotetcp    => ( is => "rw", isa => Bool, default => 1, );
has nolocaltcp     => ( is => "rw", isa => Bool, default => 1, );

has child => (
  is => 'rwp',
  isa => InstanceOf['Child::Link::Proc'],
);

has comm => (
  is => 'rwp',
  isa => GlobRef,
);

sub is_running
{
  my $self = shift;
  return defined $self->child;
}

sub run
{
  my $self = shift;
  my $child_hook = shift;

  if (defined $child_hook && ref $child_hook ne 'CODE')
  {
    croak '$child_hook was not a code ref when calling run';
  }

  use Socket;
  use IO::Handle;
  socketpair(my $child_comm, my $parent_comm, AF_UNIX, SOCK_STREAM, PF_UNSPEC);

  my $child = Child->new(sub {
    my $parent = shift;
    $0 .= " [Net::Dropbear Child]";

    $parent_comm->close;
    $self->_set_comm($child_comm);

    require Net::Dropbear::XS;

    Net::Dropbear::XS->setup_svr_opts($self);

    $child_hook->($parent)
      if defined $child_hook;

    Net::Dropbear::XS->svr_main();

    # Should never return
    croak 'Unexpected return from dropbear';
  });

  $self->_set_child($child->start);
  $child_comm->close;
  $self->_set_comm($parent_comm);

  return;
}

sub kill
{
  my $self = shift;
  if ($self->is_running)
  {
    $self->child->kill(15);
  }
}

sub wait
{
  my $self = shift;
  if ($self->is_running)
  {
    $self->child->wait;
  }
}

sub auto_hook
{
  my $self = shift;
  my $hook = shift;

  if (exists $self->hooks->{$hook})
  {
    return $self->hooks->{$hook}->(@_);
  }

  return Net::Dropbear::XS::HOOK_CONTINUE();
}

sub import
{
  require Net::Dropbear::XS;
  Net::Dropbear::XS->export_to_level(1, @_);
}

1;
__END__

=encoding utf-8

=head1 NAME

Net::Dropbear::SSHd - Embed and control a Dropbear SSH server inside of perl

=head1 SYNOPSIS

  use Net::Dropbear::SSHd;
  
  Net::Dropbear::XS::gen_key($key_filename);
  
  my $sshd = Net::Dropbear::SSHd->new(
    addrs      => '2222',
    keys       => $key_filename,
    hooks      => {
      on_log => sub
      {
        my $priority = shift;
        my $msg      = shift;
        warn( "$msg\n" );
        return HOOK_CONTINUE;
      },
    }
  );
  
  $sshd->run;
  $sshd->wait;

=head1 DESCRIPTION

Net::Dropbear::SSHd allows you to embed and control an SSH server (using Dropbear) from perl.

=head2 Motivation

Maybe you're asking yourself why you'd want to do that? Imagine that you want
to run a service where you let users run remote commands over SSH, say SFTP
or git. Also imagine that you'd like maintain the users or public keys in a
database instead of in a file.  A good example of this behavior would be
Github and other cloud-based git-over-ssh solutions.

I'm pretty confident that one could get OpenSSH to do this, but I saw a couple
problems:

=over

=item The user must be a real user

Any user that wants to connect must be a real user at the OS level. Managing
multiple users, let alone millions, is a nightmare.

=item OpenSSH really likes running as root

Until recently, running as non-root was even possible. It's now possible,
but a lot of interesting features are restricted.

=item Authorized keys can be provided through a script owned by root

A continuation of the point above, but in order to enable OpenSSH to verify
a key, a script can be provided. This script (and all directories leading
to the script) must be owned by root.

=item OpenSSH (and SSH) have a lot of options

And while that is a good thing in general, in this particular case I was not
confident that I could tune all the options correctly to make sure I wasn't
completely securing the system.

=back

I really didn't want to provide outside users with a clever way to
gain access to my machine. That's where this module comes into play. The goal
of C<Net::Dropbear::SSHd> is that you can control the entire lifecycle of
SSHd, including which usernames are accpeted, which public keys are authorized
and what commands are ran.

=head1 CONSTRUCTOR

=head2 new

  my $sshd = Net::Dropbear::SSHd({ %params });

Returns a new C<Net::Dropbear::SSHd> object.

=head3 Attributes

=over

=item addrs

A string or an array of addresses to bind to. B<Default>: Nothing

=item keys

An array of strings that are the server keys for Dropbear. B<Default>:
Generate keys automatically

=item hooks

A hashref of coderef's that get called during key points of the SSH server
session. See L</Hooks>.

=back

=head3 Dropbear options

=over

=item debug

If Dropbear is complied with trace debuging turned on (not the default),
turning this on will enable Dropbear's debugging information to be dumped.

B<Default:> off

=item forkbg

Turning the forkbg option on means that Dropbear will fork into the
background. Since Net::Dropbear::SSHd forks to run the main Dropbear code,
doing this second fork would seem redundant.

B<Default:> off

=item usingsyslog

Turning the usingsyslog option on means Dropbear will use syslog to output
it's logs. Regardless of this setting, the on_log hook will still be called.

B<Default:> off

=item norootlogin

Turning the norootlogin option on means that root can not login.

B<Default:> on

=item noauthpass

Turning the noauthpass option on means that password authentication is not
allowed

B<Default:> on

=item norootpass

Turning the norootpass option on means that root cannot authenticate using
a password.

B<Default:> on

=item allowblankpass

Turning the allowblankpass option on means that if the SSH client requests it,
Dropbear will authenticate someone with a blank password.

B<Default:> off

=item delay_hostkey

Turning the delay_hostkey option on tells Dropbear to not generate hostkey
files until the first user connects.  This allows for faster startup times
the very first time in exchange for a delayed connection for the very first
user.

B<Default:> off

=item domotd

Turning on the domotd option means that when an interactive session is
started, the message of the day is sent.

B<Default:> off

=item noremotetcp

Turning on the noremotetcp option means that Dropbear will not create remote
forwarded TCP tunnels.

B<Default:> on

=item nolocaltcp

Turning on the nolocaltcp option means that Dropbear will not create locally
forwarded TCP tunnels.

B<Default:> on

=back

=head1 Hooks

During the run of Dropbear, Net::Dropbear::SSHd hooks into certain points
of the processing.  With these hooks, the outcome of Dropbear can be changed.
Each hook can return one of the hook constants: L</HOOK_COMPLETE>,
L</HOOK_CONTINUE> or L</HOOK_FAILURE>.  Unless otherwise noted, returning
L</HOOK_CONTINUE> will result in Dropbear continuing as though the hook
hadn't been called.

=over

=item on_log(priority, message)

The on_log hook is called when Dropbear logs anything.

=over

=item HOOK_COMPLETE - No more logging will take place

=item HOOK_FAILURE - Logging will continue as normal

=back

=item on_start()

The on_start hook is called after Dropbear is done initalizing.

=over

=item HOOK_COMPLETE - Identical to HOOK_CONTINUE

=item HOOK_FAILURE - Dropbear will exit

=back

=item on_username(username)

The on_username hook is called when a username is given. Returning anything
but HOOK_CONTINUE from this will prevent L</on_passwd_fill> or
L</on_shadow_fill> from being called.

=over

=item HOOK_COMPLETE - The username is acceptable and dummy entries are used for the password file

=item HOOK_FAILURE - The username is rejected

=back

=item on_passwd_fill(L<Net::Dropbear::XS::AuthState|AuthState>, username)

The on_passwd_fill hook is called when Dropbear is filling in information
for a user from the passwd file.  The L<Net::Dropbear::XS::AuthState|AuthState>
paramater is an object that can be manipulated to fill in information for
Dropbear. See L<Net::Dropbear::XS::AuthState>. If any AuthState data is left
invalid, Dropbear will exit.

=over

=item HOOK_COMPLETE - The L<AuthState|Net::Dropbear::XS::AuthState> object should be used as the passwd information.

=item HOOK_FAILURE - The passwd information is invalid and the user connection will be rejected.

=back

=item on_shadow_fill(crypt_password, pw_name)

The on_shadow_fill hook is called when the shadow file is consulted for a
users password.  Note that this is called even if HOOK_COMPLETE is returned
from on_passwd_fill.  The first paramter (crypt_password) is mutable and
can be used to set what the user's crypted password is. If the crypt_password
is invalid (null), Dropbear will exit.

=over

=item HOOK_COMPLETE - The shadow file will not be consulted for the given user

=item HOOK_FAILURE - Ignored

=back

=item on_check_pubkey(authkeys, pw_name)

The on_check_pubkey hook is called right before the the public keys for a
user is checked. The first paramater, C<authkeys>, is an string that can be
populated with an L<authorized_keys(8)> file and it will be used to
authenticate the user given with pw_name.

=over

=item HOOK_COMPLETE - Identical to HOOK_CONTINUE

=item HOOK_FAILURE - The public keys could not be retrieved and will not be checked.

=back

=item on_new_channel(on_new_channel)

The on_new_channel hook is called when the client requests a new channel.
The first paramater, C<on_new_channel>, will contain the channel type as a
string.

=over

=item HOOK_COMPLETE - Identical to HOOK_CONTINUE

=item HOOK_FAILURE - The channel is denied with C<SSH_OPEN_ADMINISTRATIVELY_PROHIBITED>

=back

=item on_chansess_command(L<Net::Dropbear::XS::SessionAccept|chansess>)

The on_chansess_command hook is called when a new command is being requested
by the client.  The first paramater, L<Net::Dropbear::XS::SessionAccept|chansess>,
is an object that should be used to let Dropbear know how to interact with
the channel.  See L<Net::Dropbear::XS::SessionAccept> for more details.

=over

=item HOOK_COMPLETE - No attempts will be made to start the command specified

=item HOOK_CONTINUE - The values from L<Net::Dropbear::XS::SessionAccept|chansess> will be copied into Dropbear and used in Dropbear's default operations

=item HOOK_FAILURE - The command session will behave as though the command had vailed

=back

=back

=head1 METHODS

=over

=item run

Call C<$sshd->run> to start Dropbear.

=item child

If Dropbear has been started, then this will return the L<Child::Link::Proc>
object of the child process. If Dropbear is not running, this will return
C<undef>. In the child process this will be C<undef> as well.

=item comm

The C<comm> method is a convience for both parent and child processes. This
contains a two-way socket between the parent and child (and sub-children)
processes.  This is a AF_UNIX socket, which means you can pass new file
handles between the processes.

=item is_running

Returns true if Dropbear is running, false if it's not.

=item kill

This will stop Dropbear.

=item wait

This waits for Dropbear to exit after it is sent the kill signal.

=back

=head1 CONSTANTS

The constants below are exported by default.

=over

=item HOOK_COMPLETE

This is used to indicate that a hook is done and not to use Dropbear's default
operations.

=item HOOK_CONTINUE

This is used to indicate that the hook has decided not to do anything.

=item HOOK_FAILURE

This is used to indicate that the hook has failed and Dropbear should not
continue.

=back

=head1 CHILD PROCESSES

Since Dropbear is a program itself, it is ran as a child process.  Each
connection will also have it's own child process.

=head1 AUTHOR

Jon Gentle E<lt>atrodo@cpan.orgE<gt>

=head1 COPYRIGHT

Copyright 2015- Jon Gentle

=head1 LICENSE

This is free software. You may redistribute copies of it under the terms of the Artistic License 2 as published by The Perl Foundation.

This includes a complete copy of Dropbear that is patched and used. The 
majority of Dropbear is Copyright (c) 2002-2014 Matt Johnston under the MIT
license.  See L<https://matt.ucc.asn.au/dropbear/dropbear.html> for details
about Dropbear and it's license.

=cut
