This file is indexed.

/usr/share/perl5/IO/SessionData.pm is in libio-sessiondata-perl 1.03-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
# ======================================================================
#
# Copyright (C) 2000 Lincoln D. Stein
# Slightly modified by Paul Kulchenko to work on multiple platforms
# Formatting changed to match the layout layed out in Perl Best Practices
# (by Damian Conway) by Martin Kutter in 2008
#
# ======================================================================

package IO::SessionData;

use strict;
use Carp;
use IO::SessionSet;
use vars '$VERSION';
$VERSION = 1.03;

use constant BUFSIZE => 3000;

BEGIN {
    my @names = qw(EWOULDBLOCK EAGAIN EINPROGRESS);
    my %WOULDBLOCK =
        (eval {require Errno}
            ? map {
                Errno->can($_)
                    ? (Errno->can($_)->() => 1)
                    : (),
                } @names
            : ()
        ),
        (eval {require POSIX}
            ? map {
                POSIX->can($_) && eval { POSIX->can($_)->() }
                ? (POSIX->can($_)->() => 1)
                    : ()
                } @names
            : ()
        );

    sub WOULDBLOCK { $WOULDBLOCK{$_[0]+0} }
}

# Class method: new()
# Create a new IO::SessionData object.  Intended to be called from within
# IO::SessionSet, not directly.
sub new {
    my $pack = shift;
    my ($sset,$handle,$writeonly) = @_;
    # make the handle nonblocking (but check for 'blocking' method first)
    # thanks to Jos Clijmans <jos.clijmans@recyfin.be>
    $handle->blocking(0) if $handle->can('blocking');
    my $self = bless {
        outbuffer   => '',
        sset        => $sset,
        handle      => $handle,
        write_limit => BUFSIZE,
        writeonly   => $writeonly,
        choker      => undef,
        choked      => 0,
    },$pack;
    $self->readable(1) unless $writeonly;
    return $self;
}

# Object method: handle()
# Return the IO::Handle object corresponding to this IO::SessionData
sub handle {
    return shift->{handle};
}

# Object method: sessions()
# Return the IO::SessionSet controlling this object.
sub sessions {
    return shift->{sset};
}

# Object method: pending()
# returns number of bytes pending in the out buffer
sub pending {
    return length shift->{outbuffer};
}

# Object method: write_limit([$bufsize])
# Get or set the limit on the size of the write buffer.
# Write buffer will grow to this size plus whatever extra you write to it.
sub write_limit {
    my $self = shift;
    return defined $_[0]
        ? $self->{write_limit} = $_[0]
        : $self->{write_limit};
}

# set a callback to be called when the contents of the write buffer becomes larger
# than the set limit.
sub set_choke {
    my $self = shift;
    return defined $_[0]
        ? $self->{choker} = $_[0]
        : $self->{choker};
}

# Object method: write($scalar)
# $obj->write([$data]) -- append data to buffer and try to write to handle
# Returns number of bytes written, or 0E0 (zero but true) if data queued but not
# written. On other errors, returns undef.
sub write {
    my $self = shift;
    return unless my $handle = $self->handle; # no handle
    return unless defined $self->{outbuffer}; # no buffer for queued data

    $self->{outbuffer} .= $_[0] if defined $_[0];

    my $rc;
    if ($self->pending) { # data in the out buffer to write
        local $SIG{PIPE}='IGNORE';
        # added length() to make it work on Mac. Thanks to Robin Fuller <rfuller@broadjump.com>
        $rc = syswrite($handle,$self->{outbuffer},length($self->{outbuffer}));

        # able to write, so truncate out buffer apropriately
        if ($rc) {
            substr($self->{outbuffer},0,$rc) = '';
        }
        elsif (WOULDBLOCK($!)) {  # this is OK
            $rc = '0E0';
        }
        else { # some sort of write error, such as a PIPE error
            return $self->bail_out($!);
        }
    }
    else {
        $rc = '0E0';   # nothing to do, but no error either
    }

    $self->adjust_state;

    # Result code is the number of bytes successfully transmitted
    return $rc;
}

# Object method: read($scalar,$length [,$offset])
# Just like sysread(), but returns the number of bytes read on success,
# 0EO ("0 but true") if the read would block, and undef on EOF and other failures.
sub read {
    my $self = shift;
    return unless my $handle = $self->handle;
    my $rc = sysread($handle,$_[0],$_[1],$_[2]||0);
    return $rc if defined $rc;
    return '0E0' if WOULDBLOCK($!);
    return;
}

# Object method: close()
# Close the session and remove it from the monitored list.
sub close {
    my $self = shift;
    unless ($self->pending) {
        $self->sessions->delete($self);
        CORE::close($self->handle);
    }
    else {
        $self->readable(0);
        $self->{closing}++;  # delayed close
    }
}

# Object method: adjust_state()
# Called periodically from within write() to control the
# status of the handle on the IO::SessionSet's IO::Select sets
sub adjust_state {
    my $self = shift;

    # make writable if there's anything in the out buffer
    $self->writable($self->pending > 0);

    # make readable if there's no write limit, or the amount in the out
    # buffer is less than the write limit.
    $self->choke($self->write_limit <= $self->pending) if $self->write_limit;

    # Try to close down the session if it is flagged
    # as in the closing state.
    $self->close if $self->{closing};
}

# choke gets called when the contents of the write buffer are larger
# than the limit.  The default action is to inactivate the session for further
# reading until the situation is cleared.
sub choke {
    my $self = shift;
    my $do_choke = shift;
    return if $self->{choked} == $do_choke;  # no change in state
    if (ref $self->set_choke eq 'CODE') {
        $self->set_choke->($self,$do_choke);
    }
    else {
        $self->readable(!$do_choke);
    }
    $self->{choked} = $do_choke;
}

# Object method: readable($flag)
# Flag the associated IO::SessionSet that we want to do reading on the handle.
sub readable {
    my $self = shift;
    my $is_active = shift;
    return if $self->{writeonly};
    $self->sessions->activate($self,'read',$is_active);
}

# Object method: writable($flag)
# Flag the associated IO::SessionSet that we want to do writing on the handle.
sub writable {
    my $self = shift;
    my $is_active = shift;
    $self->sessions->activate($self,'write',$is_active);
}

# Object method: bail_out([$errcode])
# Called when an error is encountered during writing (such as a PIPE).
# Default behavior is to flush all buffered outgoing data and to close
# the handle.
sub bail_out {
    my $self = shift;
    my $errcode = shift;           # save errorno
    delete $self->{outbuffer};     # drop buffered data
    $self->close;
    $! = $errcode;                 # restore errno
    return;
}

1;