X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fclient.pl;h=8d2d683b1ac68974a80c2935c352380794766639;hb=c66d28ace3e5bf4b9fa20256425d7d1416e7d8c5;hp=a2a690cad22a1bd362c7b1cb5b6818b5687d7344;hpb=7a64dbf69ead057f2fd3fef1df05e30cef339485;p=spider.git diff --git a/perl/client.pl b/perl/client.pl index a2a690ca..8d2d683b 100755 --- a/perl/client.pl +++ b/perl/client.pl @@ -348,32 +348,61 @@ if ($loginreq) { my $user; my $s; + if (-e "$data/issue") { + open(I, "$data/issue") or die; + local $/ = undef; + $issue = ; + close(I); + $issue = s/\n/\r/og if $mode == 1; + local $/ = $nl; + $stdout->print($issue) if issue; + } + + DXUser->init($userfn); + # allow a login from an existing user. I could create a user but + # I want to check for valid callsigns and I don't have the + # necessary info / regular expression yet for ($state = 0; $state < 2; ) { alarm($timeout); if ($state == 0) { $stdout->print('login: '); $stdout->flush(); - local $/ = $mode == 1 ? "\r" : "\n"; + local $\ = $nl; $s = $stdin->getline(); chomp $s; + $s =~ s/\s+//og; + $s =~ s/-\d+$//o; # no ssids! + cease(0) unless $s gt ' '; $call = uc $s; $user = DXUser->get($call); $state = 1; } elsif ($state == 1) { $stdout->print('password: '); $stdout->flush(); - local $/ = $mode == 1 ? "\r" : "\n"; + local $\ = $nl; $s = $stdin->getline(); chomp $s; $state = 2; - cease(0) if !$user || ($user->passwd && $user->passwd ne $s); + if (!$user || ($user->passwd && $user->passwd ne $s)) { + $stdout->print("sorry...$nl"); + cease(0); + } } } } +# handle callsign and connection type firtling +sub doclient +{ + my $line = shift; + my @f = split /\s+/, $line; + $call = uc $f[0] if $f[0]; + $csort = $f[1] if $f[1]; +} + # is this an out going connection? if ($connsort eq "connect") { my $mcall = lc $call; @@ -391,10 +420,14 @@ if ($connsort eq "connect") { doconnect($1, $2) if /^\s*co\w*\s+(\w+)\s+(.*)$/io; doabort($1) if /^\s*a\w*\s+(.*)/io; dotimeout($1) if /^\s*t\w*\s+(\d+)/io; - dochat($1, $2) if /\s*\'(.*)\'\s+\'(.*)\'/io; + dochat($1, $2) if /\s*\'(.*)\'\s+\'(.*)\'/io; + if (/\s*cl\w+\s+(.*)/io) { + doclient($1); + last; + } } - dbg('connect', "Connected to $call, starting normal protocol"); + dbg('connect', "Connected to $call ($csort), starting normal protocol"); dbgsub('connect'); # if we get here we are connected