This file is indexed.

/usr/share/perl5/Net/Server/Multiplex.pm is in libnet-server-perl 2.009-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
# -*- perl -*-
#
#  Net::Server::Multiplex - Net::Server personality
#
#  $Id$
#
#  Copyright (C) 2001-2017
#
#    Rob Brown <bbb@cpan,org>
#
#    Paul Seamons <paul@seamons.com>
#
#  This package may be distributed under the terms of either the
#  GNU General Public License
#    or the
#  Perl Artistic License
#
################################################################

package Net::Server::Multiplex;

use strict;
use base qw(Net::Server);
use Net::Server::SIG qw(register_sig check_sigs);
use Carp qw(confess);
eval { require IO::Multiplex; import IO::Multiplex 1.05; };
$@ && warn "Module IO::Multiplex is required for Multiplex.";

our $VERSION = $Net::Server::VERSION;

sub net_server_type { __PACKAGE__ }

sub loop {
    my $self = shift;
    my $prop = $self->{server};

    my $mux = IO::Multiplex->new;
    $self->{mux} = $mux;

    foreach my $sock ( @{ $prop->{sock} } ) {
        if (Net::Server::SOCK_DGRAM == $sock->getsockopt(Socket::SOL_SOCKET(),Socket::SO_TYPE())) {
            $mux->add($sock);
        } else {
            $mux->listen($sock);
        }
    }
    $mux->set_callback_object(Net::Server::Multiplex::MUX->init($self));

    ###
    ### Use Net::Server::SIG for safe signal handling.
    ###

    ### register some of the signals for safe handling
    register_sig(PIPE => sub { $self->log(4, "SIG$_[0] received") },
                 INT  => sub { $self->server_close() },
                 TERM => sub { $self->server_close() },
                 QUIT => sub { $self->server_close() },
                 HUP  => sub { $self->sig_hup() },
                 CHLD => sub { $self->sig_chld() },
                );

    if ( defined $prop->{check_for_dequeue} ) {
        # It does not matter which socket the timeout is associated with.
        $mux->set_timeout( $prop->{sock}->[0], $prop->{check_for_dequeue} );
    }

    $mux->loop(sub {
        my ($rdready, $wrready) = @_;
        check_sigs();
        $mux->endloop if $prop->{_HUP};
    });

    ### fall back to the main run routine
}

### make sure that we properly disconnect from the mux if we are HUPing
sub sig_hup {
    my $self = shift;
    my $prop = $self->{server};

    if (my $mux  = $self->{mux}) {
        foreach my $sock ( @{ $prop->{sock} } ){
            $mux->remove($sock);
        }
    }

    return $self->SUPER::sig_hup(@_);
}

# This method instead of run_client_connection
# because STDOUT should be tied correctly,
# not just globbed onto the socket.  This
# tie is taken care of in the mux_connection
# routine instead of within post_accept.
# Also, the process_request stuff should never be
# used since the request should be really processed
# via mux_* methods.

sub setup_client_connection {
    my ($self, $mux) = @_;
    my $prop = $self->{server};

    ### Copied from Net::Server::post_accept...
    $prop->{requests} ++;
    if (! $prop->{no_client_stdout}) {
        *STDIN  = \*{ $prop->{client} };
        #  *STDOUT = \*{ $prop->{client} };
        #  STDIN->autoflush(1);
    }

    ### Copied from Net::Server::run_client_connection...
    $self->get_client_info;     # determines information about peer and local
    $self->post_accept_hook;    # user customizable hook
    unless($self->allow_deny &&       # do allow/deny check on client info
    $self->allow_deny_hook ){  # user customizable hook
        $self->request_denied_hook;     # user customizable hook
        # Flush output buffer and close connection since it should be denied.
        if (! $prop->{no_client_stdout}) {
            close (STDOUT);
        }
        return 0;
    }
    return 1;
}

# Compatibility interface for Net::Server
sub run_dequeue {
    confess "&$Net::Server::Multiplex::MUX::ISA[0]\::run_dequeue never defined";
}

sub mux_connection {}
sub mux_input {
    confess "&$Net::Server::Multiplex::MUX::ISA[0]\::mux_input never defined";
}
sub mux_eof {}
sub mux_close {}
sub mux_timeout {
    confess "&$Net::Server::Multiplex::MUX::ISA[0]\::mux_timeout never defined";
}

package Net::Server::Multiplex::MUX;

# Just a dumb module to be used for the
# Multiplex callback_object hooks

use strict;

our $VERSION = $Net::Server::Multiplex::VERSION;
# This temporary @ISA should always be overridden
# at runtime when init() is called.  This module should
# really ISA whatever module ISA Net::Server::Multiplex.
our @ISA = qw(Net::Server::Multiplex);

# This subroutine is meant to create the main callback
# object to be used for all listen file descriptors.
# It just needs to make sure the {net_server} property
# is set.
sub init {
    my $package  = shift;
    my $net_server= shift;
    # On-the-fly runtime molymorphism hack
    # to ISA the same type of thing passed.
    @ISA = (ref $net_server);
    my $self     = bless {
        net_server => $net_server,
    } => $package;
    return $self;
}

# The new() routine is passed the Net::Server object.  It
# is meant to create the client specific callback object.
# Note that the $net_server->{server} property hash may be
# modified by future connections through Net::Server.
# Any values within it that this object may need to use
# later must be copied within itself.
sub new {
    my $package    = shift;
    my $net_server = shift;
    my $self       = bless {
        # Some nice values to remember for this client
        net_server => $net_server,
        peeraddr   => $net_server->{server}->{peeraddr},
        connected  => time,
    }, $package;
    return $self;
}

sub log { shift->{net_server}->log(@_) }

# This subroutine is only used by the listen callback object.
sub mux_connection {
    my ($self, $mux, $fh) = @_;
    my $net_server = $self->{net_server};
    $net_server->{server}->{client} = $fh;

    $self->_link_stdout($mux, $fh);

    if ($net_server->setup_client_connection($mux)) {
        # Create client specific callback object
        my $client_object = Net::Server::Multiplex::MUX->new($net_server, $fh);

        # Set this as the callback object for this client
        $mux->set_callback_object($client_object, $fh);

        # Finally call the clients real mux_connection routine,
        # if any.  This allows all the mux_* routines to be
        # called from the same type of object.
        $client_object->SUPER::mux_connection($mux, $fh);
        #$client_object->mux_connection($mux, $fh);
    }

    $self->_unlink_stdout();

    return;
}

sub mux_input {
    my ($self, $mux, $fh, $in_ref) = @_;
    $self->_link_stdout($mux, $fh);
    $self->SUPER::mux_input($mux, $fh, $in_ref);
    $self->_unlink_stdout();
    return;
}

sub mux_eof {
    my ($self, $mux, $fh, $in_ref) = @_;
    $self->_link_stdout($mux, $fh);
    $self->SUPER::mux_eof($mux, $fh, $in_ref);
    $self->_unlink_stdout();
    $mux->shutdown($fh, 1);
    return;
}

sub mux_close {
    my ($self, $mux, $fh) = @_;
    $self->{net_server}->post_process_request_hook;
    $self->SUPER::mux_close($mux, $fh);
    return;
}

sub mux_timeout {
    my ($self, $mux, $fh) = @_;

    if ( my $check = $self->{net_server}->{server}->{check_for_dequeue} ) {
        $self->{net_server}->run_dequeue();
        $mux->set_timeout( $fh, $check );
    } else {
        $self->_link_stdout($mux, $fh);
        $self->SUPER::mux_timeout($mux, $fh);
        $self->_unlink_stdout();
    }
    return;
}

sub _link_stdout {
    my ($self, $mux, $fh) = @_;
    return if $self->{net_server}->{server}->{no_client_stdout};

    # Hook up STDOUT to the correct socket
    if (tied *$fh) {
        # Make sure STDOUT is tied however $fh is
        tie (*STDOUT, (ref tied *$fh), $mux, $fh);
    } else {
        *STDOUT = *$fh;
    }
}

sub _unlink_stdout {
    my $self = shift;
    return if $self->{net_server}->{server}->{no_client_stdout};
    my $x = tied *STDOUT;
    if ($x) {
        undef $x;
        untie *STDOUT;
    }
}

1;

__END__

=head1 NAME

Net::Server::Multiplex - Multiplex several connections within one process

=head1 SYNOPSIS

    package MyPlexer;

    use base qw(Net::Server::Multiplex);

    sub mux_input {
        #...code...
    }

    __PACKAGE__->run();

=head1 DESCRIPTION

This personality is designed to handle multiple connections all within
one process.  It should only be used with protocols that are
guaranteed to be able to respond quickly on a packet by packet basis.
If determining a response could take a while or an unknown period of
time, all other connections established will block until the response
completes.  If this condition might ever occur, this personality
should probably not be used.

This takes some nice features of Net::Server (like the server listen
socket setup, configuration file processing, safe signal handling,
convenient inet style STDIN/STDOUT handling, logging features,
deamonization and pid tracking, and restartability -SIGHUP) and some
nice features of IO::Multiplex (automatic buffered IO and
per-file-handle objects) and combines them for an easy-to-use
interface.

See examples/samplechat.pl distributed with Net::Server for a simple
chat server that uses several of these features.

=head1 PROCESS FLOW

The process flow is written in an open, easy to override, easy to
hook, fashion.  The basic flow is shown below.

    $self->configure_hook;

    $self->configure(@_);

    $self->post_configure;

    $self->post_configure_hook;

    $self->pre_bind;

    $self->bind;

    if (Restarting server) {
        $self->restart_open_hook();
    }

    $self->post_bind_hook;

    $self->post_bind;

    $self->pre_loop_hook;

    $self->loop; # This basically just runs IO::Multiplex::loop
    # For routines inside a $self->loop
    # See CLIENT PROCESSING below

    $self->pre_server_close_hook;

    $self->post_child_cleanup_hook;

    $self->server_close;

    if (Restarting server) {
        $self->restart_close_hook();
        $self->hup_server;
        # Redo process again starting with configure_hook
  }

The server then exits.

=head1 CLIENT PROCESSING

The following represents the client processing program flow:

    $self->{server}->{client} = Net::Server::Proto::TCP->accept();  # NOTE: Multiplexed with mux_input() below

    if (check_for_dequeue seconds have passed) {
        $self->run_dequeue();
    }

    $self->get_client_info;

    $self->post_accept_hook; # Net::Server style

    if ($self->allow_deny
        && $self->allow_deny_hook) {

      # (Net::Server style $self->process_request() is never called.)

      # A unique client specific object is created
      # for all mux_* methods from this point on.
      $self = __PACKAGE__->new($self, client);

      $self->mux_connection; # IO::Multiplex style

      for (every packet received) {
        $self->mux_input;  # NOTE: Multiplexed with accept() above
      }

    } else {

      $self->request_denied_hook;

      # Notice that if either allow_deny or allow_deny_hook fails, then
      # new(), mux_connection(), and mux_input() will never be called.
      # mux_eof() and mux_close() will still be called, but using a
      # common listen socket callback object instead of a unique client
      # specific object.

    }

    $self->mux_eof;

    $self->post_process_request_hook;

    $self->mux_close;


This process then loops multiplexing between the accept() for the next
connection and mux_input() when input arrives to avoid blocking either
one.

=head1 HOOKS

The *_hook methods mentioned above are meant to be overridden with
your own subroutines if you desire to provide additional
functionality.

The loop() method of Net::Server has been overridden to run the loop
routine of IO::Multiplex instead.  The Net::Server methods may access
the IO::Multiplex object at C<$self-E<gt>{mux}> if desired.  The
IO::Multiplex methods may access the Net::Server object at
C<$self-E<gt>{net_server}> if desired.

The process_request() method is never used with this personality.

The other Net::Server hooks and methods should work the same.

=over 4

=item C<$self-E<gt>run_dequeue()>

This hook only gets called in conjunction with the check_for_dequeue
setting.  It will run every check_for_dequeue seconds.  Since no
forking is done, this hook should run fast in order to prevent
blocking the rest of the processing.

=back

=head1 TIMEOUTS

=head2 set_timeout

To utilize the optional timeout feature of IO::Multiplex, you need to
specify a timeout by using the set_timeout method.

$self->{net_server}->{mux}->set_timeout($fh, $seconds_from_now);

$fh may be either a client socket or a listen socket file descriptor
within the mux.  $seconds_from_now may be fractional to achieve more
precise timeouts.  This is used in conjunction with mux_timeout, which
you should define yourself.

=head2 mux_timeout

The main loop() routine will call $obj->mux_timeout($mux, $fh) when
the timeout specified in set_timeout is reached where $fh is the same
as the one specified in set_timeout() and $obj is its corresponding
object (either the unique client specific object or the main listen
callback object) and $mux is the main IO::Multiplex object itself.

=head1 CALLBACK INTERFACE

Callback objects should support the following interface.  You do not
have to provide all of these methods, just provide the ones you are
interested in.  These are just like the IO::Multiplex hooks except
that STDOUT is tied to the corresponding client socket handle for your
convenience and to more closely emulate the Net::Server model.
However, unlike some other Net::Server personalities, you should never
read directly from STDIN yourself.  You should define one or more of
the following methods:

=head2 mux_connection ($mux,$fh)

(OPTIONAL) Run once when the client first connects if the allow_deny
passes.  Note that the C<$self-E<gt>{net_server}-E<gt>{server}>
property hash may be modified by future connections through
Net::Server.  Any values within it that this object may need to use
later should be copied within its own object at this point.

  Example:
  $self->{peerport} = $self->{net_server}->{server}->{peerport};

=head2 mux_input ($mux,$fh,\$data)

(REQUIRED) Run each time a packet is read.  It should consume $data
starting at the left and leave unconsumed data in the scalar for
future calls to mux_input.

=head2 mux_eof ($mux,$fh,\$data)

(OPTIONAL) Run once when the client is done writing.  It should
consume the rest of $data since mux_input() will never be run again.

=head2 mux_close ($mux,$fh)

(OPTIONAL) Run after the entire client socket has been closed.  No
more attempts should be made to read or write to the client or to
STDOUT.

=head2 mux_timeout ($mux,$fh)

(OPTIONAL) Run once when the set_timeout setting expires as explained
above.

=head1 BUGS

This is only known to work with TCP servers.

If you need to use the IO::Multiplex style set_timeout / mux_timeout
interface, you cannot use the Net::Server style check_for_dequeue /
run_dequeue interface.  It will not work if the check_for_dequeue
option is specified.  The run_dequeue method is just a compatibility
interface to comply with the Net::Server::Fork style run_dequeue but
is implemented in terms of the IO::Multiplex style set_timeout and
mux_timeout methods.

=head1 AUTHOR

Rob Brown <bbb@cpan.org>

=head1 MAINTAINER

Paul Seamons <paul@seamons.com>

=head1 LICENSE

  This package may be distributed under the terms of either the
  GNU General Public License
     or the
  Perl Artistic License

  All rights reserved.

=head1 SEE ALSO

L<Net::Server> by Paul Seamons <paul@seamons.com>,

L<IO::Multiplex> by Bruce Keeler <bruce@gridpoint.com>.

=cut