7 use Exporter
qw{import
};
8 use Socket
qw{:DEFAULT
:addrinfo
};
10 our @EXPORT_OK = qw{get_response0 decode_response get_response
11 send_command0 send_command
13 load_config connect_to_server
};
17 sub split_response_code
($) {
19 my $c = $st%10; $st = int($st/10);
20 my $b = $st%10; $st = int($st/10);
25 sub get_response0
($) {
27 (my $st, my $r) = split ' ', (readline $sk), 2;
30 my ($a, $b, $c) = split_response_code
$st;
32 if ($c == 5) { return $st, undef; }
33 else { die "server error: $r"; }
35 elsif ($a != 2) { die "unexpected status code $a"; }
36 else { return $st, $r; }
39 sub decode_response
($$$) {
40 my ($sk, $st, $r) = @_;
41 my ($a, $b, $c) = split_response_code
$st;
43 if ($c == 0 || $c == 5 || $c == 9) { return undef; }
44 elsif ($c == 1 || $c == 2) { return $r; }
48 chomp (my $line = readline $sk);
49 last LINE
if $line eq ".";
54 } else { die "unexpected format code $c in $st"; }
57 sub get_response
($) {
59 my ($st, $r) = get_response0
$sk;
60 return decode_response
$sk, $st, $r;
63 sub send_command0
($@
) {
68 if ($f eq "" || $f =~ /[\\"'\s]/) {
69 $f =~ s/([\\"])/\\$1/g;
76 return get_response0
$sk;
79 sub send_command
($@
) {
81 my ($st, $r) = send_command0
$sk, @f;
82 return decode_response
$sk, $st, $r;
85 sub split_fields
($) {
92 last FIELD
if $l eq "";
93 if ($l =~ /^(["'])/) {
95 ($f, $l) = $l =~ /^ $q ((?: [^\\$q]+ | \\ .)* ) $q (.*) $/x;
98 ($f, $l) = split ' ', $l, 2; $l //= "";
105 sub load_config
($) {
107 my %conf = (connect => ["-unix", "/var/lib/disorder/socket"]);
109 open my $fh, "<", $conf;
110 LINE
: while (<$fh>) {
112 next LINE
unless /^\s*[^\s#]/;
113 (my $k, my @f) = split;
117 for my $i (qw{ username password
})
118 { die "missing configuration keyword `$i'" unless exists $conf{$i}; }
122 sub connect_to_server
(\
%;$) {
123 my ($conf, $quietp) = @_;
127 my @a = $conf->{connect}->@
*;
128 die "empty address" unless @a;
129 if ($a[0] eq "-unix") { $af = AF_UNIX
; shift @a; }
130 elsif ($a[0] eq "-4") { $af = AF_INET
; shift @a; }
131 elsif ($a[0] eq "-6") { $af = AF_INET6
; shift @a; }
132 elsif ($a[0] eq "-") { shift @a; }
133 die "empty address" unless @a;
137 if ($af == AF_UNIX
|| ($af == AF_UNSPEC
&& $a[0] =~ m{^/})) {
138 @i = ({ family
=> AF_UNIX
, addr
=> pack_sockaddr_un
($a[0]) });
141 die "missing port" unless @a >= 2;
142 (my $e, @i) = getaddrinfo
$a[0], $a[1],
143 { family
=> $af, socktype
=> SOCK_STREAM
};
144 die "getaddrinfo (host `$a[0]', service `$a[1]'): $e" if $e;
147 die "junk in address" if @a;
151 ADDR
: for my $i (@i) {
153 socket $sk, $i->{family
}, SOCK_STREAM
, 0;
154 connect $sk, $i->{addr
};
157 close $sk if defined $sk;
162 unless (defined $sk) {
163 die "failed to connect" if $quietp;
164 print STDERR
"failed to connect!\n";
165 for (my $i = 0; $i < @i; $i++) {
166 if ($i[$i]{family
} == AF_UNIX
)
167 { $a = unpack_sockaddr_un
$i[$i]{addr
}; }
169 my ($e, $host, $svc) = getnameinfo
$i[$i]{addr
},
170 NI_NUMERICHOST
| NI_NUMERICSERV
;
171 die "getnameinfo: $e" if $e;
172 $a = $host . ":" . $svc;
174 print STDERR
"\t$a: $e[$i]\n";
180 @f = split_fields get_response
$sk;
181 die "expected version 2" unless $f[0] eq "2";
182 my $h = Digest
::SHA
->new($f[1]);
183 $h->add($conf->{password
}[0], pack "H*", $f[2]);
184 my $d = $h->hexdigest;
185 send_command
$sk, "user", $conf->{username
}[0], $d;