File Coverage

File:blib/lib/FUSE/Server.pm
Coverage:9.2%

linestmtbrancondsubtimecode
1package FUSE::Server;
2
3require 5;
4
1
1
1
1
8
3
8
use strict;
5
6
1
1
1
1
9
3
9
use vars qw($VERSION @ISA @EXPORT);
7
8
1
1
1
1
13
4
7
use IO::Socket;
9
1
1
1
1
13
4
16
use IO::Select;
10
11require Exporter;
12
13@ISA = qw(Exporter);
14@EXPORT = qw();
15$VERSION = '1.19';
16
17my $nextid = 0;
18
19sub new {
20
0
0
        my ($class,$params) = @_;
21
0
        my $self = {};
22
0
0
        bless $self,ref $class || $class;
23
0
0
        $self->{quiet} = ${$params}{Quiet};
24
0
0
0
        $self->{port} = ${$params}{Port} || 1024;
25
0
0
0
        $self->{maxc} = ${$params}{MaxClients} || SOMAXCONN;
26
0
        $self->{max_msglen} = 1024;
27
0
        $self->{server_sock} = 0;
28
0
        $self->{sel} = 0;
29
0
        $self->{users} = {};
30
0
        return $self;
31}
32
33sub bind {
34
0
0
        my ($self) = @_;
35
36
0
        $self->{server_sock} = IO::Socket::INET->new(Proto=>"tcp", LocalPort=>$self->{port}, Listen=>$self->{maxc}, Reuse=>1);
37
0
        $self->{sel} = IO::Select->new($self->{server_sock});
38
39
0
        return $self->{server_sock}->sockhost();
40}
41
42sub start {
43
0
0
        my ($self) = @_;
44
45
0
        while (my @ready = $self->{sel}->can_read) {
46
47
0
                foreach my $client (@ready) {
48
49
0
0
                        if ($client == $self->{server_sock}) {
50
51
0
                                my $add = $client->accept;
52
0
                                $add->blocking(0);
53
0
                                $self->{sel}->add($add);
54
0
                                $self->newsession($add);
55                        }else{
56
57
0
                                my ($in,$msg,$nread,$nsafe);
58
59
0
                                do {
60
0
                                        $nread = sysread($client, $in, 1024);
61
0
                                        $msg .= $in;
62
0
                                        $nsafe = 0;
63
0
0
                                        if (defined($nread)){
64
0
                                                $nsafe = $nread;
65                                        }
66                                } while ($nsafe == 1024);
67
68
0
0
                                if (defined($nread)) {
69
0
0
                                        if ($nread == 0){
70
0
                                                $self->{sel}->remove($client);
71
0
                                                $self->endsession($client);
72
0
                                                close($client);
73                                        }
74                                }
75
76
0
0
                                if (defined($msg)){
77
0
0
                                        if ($msg){
78
0
                                                $self->incoming($client, $msg);
79                                        }
80                                }
81                        }
82                }
83        }
84}
85
86sub stop{
87
0
0
        my ($self) = @_;
88
89
0
        close($self->{server_sock});
90}
91
92sub addCallback{
93
0
0
        my ($self,$msg,$coderef) = @_;
94
0
        $self->{callbacks}{$msg} = $coderef;
95}
96
97sub defaultCallback{
98
0
0
        my ($self,$coderef) = @_;
99
0
        $self->{def_callback} = $coderef;
100}
101
102sub send{
103
0
0
        my ($self,$uid,$msg,$params) = @_;
104
105
0
0
        for (keys %{$self->{users}}){
106
0
0
                if ($self->{users}{$_}{id} == $uid){
107
0
                        my $sock = $self->{users}{$_}{sock};
108
0
                        print $sock "# $msg\cM";
109
0
                        print $sock "$params\cM";
110
0
                        print $sock "##\cM\cJ";
111
0
                        last;
112                }
113        }
114}
115
116sub sendAll{
117
0
0
        my ($self,$msg,$params) = @_;
118
0
0
        for (keys %{$self->{users}}){
119
0
                $self->send($self->{users}{$_}{id},$msg,$params);
120        }
121}
122
123
124##########
125
126sub newsession {
127
0
0
        my ($self,$sock) = @_;
128
0
        $nextid++;
129
0
        $self->{users}{$sock}{sock} = $sock;
130
0
        $self->{users}{$sock}{host} = $sock->peerhost;
131
0
        $self->{users}{$sock}{id} = $nextid;
132
0
        $self->{users}{$sock}{buffer} = '';
133
134
0
0
        unless ($self->{quiet}){
135
0
                print "new connection: ";
136
0
                print $self->{users}{$sock}{id};
137
0
                print " (";
138
0
                print $self->{users}{$sock}{host};
139
0
                print ")\n";
140        }
141
142
0
        $self->packet($sock, 'client_start', '');
143}
144
145sub endsession {
146
0
0
        my ($self,$sock) = @_;
147
148
0
0
        unless ($self->{quiet}){
149
0
                print "connection closed: ";
150
0
                print $self->{users}{$sock}{id};
151
0
                print "\n";
152        }
153
154
0
        $self->packet($sock, 'client_stop', '');
155
156
0
        delete $self->{users}{$sock};
157}
158
159sub incoming{
160
0
0
        my ($self,$sock,$data) = @_;
161
162
0
        my $id = $self->{users}{$sock}{id};
163
0
        $self->{users}{$sock}{buffer} .= $data;
164
165
0
        my $ok = 1;
166
0
        my $buffer = $self->{users}{$sock}{buffer};
167
0
        while ($ok){
168
0
                $ok = 0;
169
0
0
                if (length($buffer) > 4){
170
0
                        my $size = substr($buffer,0,4);
171
0
                        $size =~ s/[^0-9]//g;
172
0
                        $size += 0;
173
0
0
                        if (length($buffer) >= 4 + $size){
174
0
                                my $packet = substr($buffer,4,$size);
175
0
                                my $a = index($packet,' ');
176
0
                                my $msg = substr($packet,0,$a);
177
0
                                my $param = substr($packet,$a+1);
178
0
                                $self->packet($sock,$msg,$param);
179
0
                                $buffer = substr($buffer,4+$size);
180
0
                                $ok=1;
181                        }
182                }
183        }
184
0
        $self->{users}{$sock}{buffer} = $buffer;
185}
186
187sub packet {
188
0
0
        my ($self,$sock,$msg,$params) = @_;
189
190
0
        my $uid = $self->{users}{$sock}{id};
191
192
0
0
        unless($self->{quiet}){
193
0
                print "packet sent to $uid: $msg\n";
194        }
195
196
0
0
        if ($self->{callbacks}{$msg}){
197
0
0
                &{$self->{callbacks}{$msg}}($uid,$msg,$params);
198        }else{
199
0
0
                if ($self->{def_callback}){
200
0
0
                        &{$self->{def_callback}}($uid,$msg,$params);
201                }
202        }
203}
204
205
2061;