| ############################################################################### |
| ############################################################################### |
| # Smtp.pl # |
| # Smtp.pm # |
| |
| # $Date: 01.05.16 $ # |
| ############################################################################### |
| ############################################################################### |
| # YaBB: Yet another Bulletin Board # |
| # YaBB: Yet another Bulletin Board # |
| # Open-Source Community Software for Webmasters # |
| # Open-Source Community Software for Webmasters # |
| # Version: YaBB 2.5.2 # |
| # Version: YaBB 2.6.12 # |
| # Packaged: October 21, 2012 # |
| # Packaged: January 5, 2016 # |
| # Distributed by: http://www.yabbforum.com # |
| # Distributed by: http://www.yabbforum.com # |
| # =========================================================================== # |
| # =========================================================================== # |
| # Copyright (c) 2000-2012 YaBB (www.yabbforum.com) - All Rights Reserved. # |
| # Copyright (c) 2000-2016 YaBB (www.yabbforum.com) - All Rights Reserved. # |
| # Software by: The YaBB Development Team # |
| # Software by: The YaBB Development Team # |
| # with assistance from the YaBB community. # |
| # with assistance from the YaBB community. # |
| ############################################################################### |
| ############################################################################### |
| |
| use English '-no_match_vars'; |
| |
| our $VERSION = '2.6.12'; |
| |
| |
| $smtpplver = 'YaBB 2.5.2 $Revision: 1.0 $'; |
| $smtppmver = 'YaBB 2.6.12 $Revision: 1710 $'; |
| if ($action eq 'detailedversion') { return 1; } |
| if ( $action eq 'detailedversion' ) { return 1; } |
| |
| |
| eval q^ |
| eval q{ |
| use IO::Socket::INET; |
| use IO::Socket::INET; |
| use Digest::HMAC_MD5 qw(hmac_md5_hex); |
| use Digest::HMAC_MD5 qw(hmac_md5_hex); |
| ^; |
| }; |
| |
| |
| &LoadLanguage('Smtp'); |
| LoadLanguage('Smtp'); |
| |
| |
| sub use_smtp { |
| sub use_smtp { |
| $| = 1; |
| my ($smtpaddr); |
| # my ($code, $text, $more); |
| $OUTPUT_AUTOFLUSH = 1; |
| # my (%features); |
| my ($proto) = ( getprotobyname 'tcp' )[2]; |
| my ($proto) = (getprotobyname('tcp'))[2]; |
| my ($port) = ( getservbyname 'smtp', 'tcp' )[2] || 25; |
| my ($port) = (getservbyname('smtp', 'tcp'))[2] || 25; |
| if ( $smtp_server =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/xsm ) { |
| my ($smtpaddr) = ($smtp_server =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/) ? pack('C4', $1, $2, $3, $4) : (gethostbyname($smtp_server))[4]; |
| $smtpaddr = |
| $sendlog = ""; |
| ( $smtp_server =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/xsm ) |
| $auth_ok = 0; |
| ? pack( 'C4', $1, $2, $3, $4 ) |
| |
| : ( gethostbyname $smtp_server )[4]; |
| # Connect to the SMTP server. |
| } |
| $sock = IO::Socket::INET->new( |
| $sendlog = q{}; |
| PeerAddr => $smtp_server, |
| $auth_ok = 0; |
| PeerPort => $port, |
| |
| Proto => 'tcp', |
| # Connect to the SMTP server. |
| Timeout => 5) |
| $sock = IO::Socket::INET->new( |
| # Check if the service is available and parse any errors |
| PeerAddr => $smtp_server, |
| or &fatal_error("smtp_unavail"); |
| PeerPort => $port, |
| |
| Proto => 'tcp', |
| &get_line; |
| Timeout => 5 |
| &say_hello ($smtp_server) or exit (1); |
| ) |
| |
| |
| if (defined ($features{'AUTH'}) && $smtp_auth_required) { |
| # Check if the service is available and parse any errors |
| # Try CRAM-MD5 if supported by the server |
| or fatal_error('smtp_unavail'); |
| if ($auth_ok == 0 && ($features{'AUTH'} =~ /CRAM-MD5/i || $smtp_auth_required == 3 || $smtp_auth_required == 4)) { |
| |
| &send_line ("AUTH CRAM-MD5\r\n"); |
| get_line(); |
| ($code, $text, $more) = &get_line; |
| say_hello($smtp_server) or exit 1; |
| if ($code != 334 && $smtp_auth_required != 4) |
| |
| { |
| if ( $features{'AUTH'} && $smtp_auth_required ) { |
| &fatal_error("smtp_error","[$code]: $smtp_txt{$code}<br /><br /><b>$smtp_txt{'5'}</b><br />$sendlog"); |
| |
| # return 0; |
| # Try CRAM-MD5 if supported by the server |
| } |
| if ( |
| my $response = &encode_cram_md5 ($text, $authuser, $authpass); |
| $auth_ok == 0 |
| &send_line ("%s\r\n", $response); |
| && ( $features{'AUTH'} =~ /CRAM-MD5/ixsm |
| ($code, $text, $more) = &get_line; |
| || $smtp_auth_required == 3 |
| if ($code != 235 && $smtp_auth_required != 4) |
| || $smtp_auth_required == 4 ) |
| { |
| ) |
| &fatal_error("smtp_error","[$code]: $smtp_txt{$code}<br /><br /><b>$smtp_txt{'5'}</b><br />$sendlog"); |
| { |
| # return 0; |
| send_line("AUTH CRAM-MD5\r\n"); |
| } |
| ( $code, $text, $more ) = get_line(); |
| $auth_ok = 1; |
| if ( $code != 334 && $smtp_auth_required != 4 ) { |
| } |
| fatal_error( 'smtp_error', |
| # Or try LOGIN method |
| "[$code]: $smtp_txt{$code}<br /><br /><b>$smtp_txt{'5'}</b><br />$sendlog" |
| elsif ($auth_ok == 0 && ($features{'AUTH'} =~ /LOGIN/i || $smtp_auth_required == 2 || $smtp_auth_required == 4)) { |
| ); |
| &send_line ("AUTH LOGIN\r\n"); |
| |
| ($code, $text, $more) = &get_line; |
| } |
| if ($code != 334 && $smtp_auth_required != 4) |
| my $response = encode_cram_md5( $text, $authuser, $authpass ); |
| { |
| send_line( "%s\r\n", $response ); |
| &fatal_error("smtp_error","[$code]: $smtp_txt{$code}<br /><br /><b>$smtp_txt{'5'}</b><br />$sendlog"); |
| ( $code, $text, $more ) = get_line(); |
| # return 0; |
| if ( $code != 235 && $smtp_auth_required != 4 ) { |
| } |
| fatal_error( 'smtp_error', |
| |
| "[$code]: $smtp_txt{$code}<br /><br /><b>$smtp_txt{'5'}</b><br />$sendlog" |
| &send_line ("%s\r\n", encode_smtp64 ($authuser, "")); |
| ); |
| |
| } |
| ($code, $text, $more) = &get_line; |
| $auth_ok = 1; |
| if ($code != 334 && $smtp_auth_required != 4) |
| } |
| { |
| |
| &fatal_error("smtp_error","[$code]: $smtp_txt{$code}<br /><br /><b>$smtp_txt{'5'}</b><br />$sendlog"); |
| # Or try LOGIN method |
| # return 0; |
| elsif ( |
| } |
| $auth_ok == 0 |
| &send_line ("%s\r\n", encode_smtp64 ($authpass, "")); |
| && ( $features{'AUTH'} =~ /LOGIN/ism |
| ($code, $text, $more) = &get_line; |
| || $smtp_auth_required == 2 |
| if ($code != 235 && $smtp_auth_required != 4) |
| || $smtp_auth_required == 4 ) |
| { |
| ) |
| &fatal_error("smtp_error","[$code]: $smtp_txt{$code}<br /><br /><b>$smtp_txt{'5'}</b><br />$sendlog"); |
| { |
| # return 0; |
| send_line("AUTH LOGIN\r\n"); |
| } |
| ( $code, $text, $more ) = get_line(); |
| $auth_ok = 1; |
| if ( $code != 334 && $smtp_auth_required != 4 ) { |
| } |
| fatal_error( 'smtp_error', |
| # Or finally PLAIN if nothing else was supported. |
| "[$code]: $smtp_txt{$code}<br /><br /><b>$smtp_txt{'5'}</b><br />$sendlog" |
| elsif ($auth_ok == 0 && ($features{'AUTH'} =~ /PLAIN/i || $smtp_auth_required == 1 || $smtp_auth_required == 4)) { |
| ); |
| &send_line ("AUTH PLAIN %s\r\n", |
| } |
| encode_smtp64 ("$authuser\0$authuser\0$authpass", "")); |
| send_line( "%s\r\n", encode_smtp64( $authuser, q{} ) ); |
| ($code, $text, $more) = &get_line; |
| |
| if ($code != 235 && $smtp_auth_required != 4) |
| ( $code, $text, $more ) = get_line(); |
| { |
| if ( $code != 334 && $smtp_auth_required != 4 ) { |
| &fatal_error("smtp_error","[$code]: $smtp_txt{$code}<br /><br /><b>$smtp_txt{'5'}</b><br />$sendlog"); |
| fatal_error( 'smtp_error', |
| # return 0; |
| "[$code]: $smtp_txt{$code}<br /><br /><b>$smtp_txt{'5'}</b><br />$sendlog" |
| } |
| ); |
| $auth_ok = 1; |
| } |
| } |
| send_line( "%s\r\n", encode_smtp64( $authpass, q{} ) ); |
| # Decide to complain about advertised methods not supported. |
| ( $code, $text, $more ) = get_line(); |
| else |
| if ( $code != 235 && $smtp_auth_required != 4 ) { |
| { |
| fatal_error( 'smtp_error', |
| &fatal_error("smtp_error","$smtp_txt{'notsupported'}<br /><br /><b>$smtp_txt{'5'}</b><br />$sendlog"); |
| "[$code]: $smtp_txt{$code}<br /><br /><b>$smtp_txt{'5'}</b><br />$sendlog" |
| # return 0; |
| ); |
| } |
| } |
| } |
| $auth_ok = 1; |
| |
| } |
| # build the Date per RFC822 - uses gmtime to create date & time stamp |
| |
| ($smtpsec, $smtpmin, $smtphour, $smtpmday, $smtpmon, $smtpyear, $smtpwday, $smtpyday, $smtpisdst) = gmtime($date + (3600 * $timeoffset)); |
| # Or finally PLAIN if nothing else was supported. |
| $smtpyear = sprintf("%02d", ($smtpyear - 100)); |
| elsif ( |
| $smtphour = sprintf("%02d", $smtphour); |
| $auth_ok == 0 |
| $smtpmin = sprintf("%02d", $smtpmin); |
| && ( $features{'AUTH'} =~ /PLAIN/ism |
| $smtpsec = sprintf("%02d", $smtpsec); |
| || $smtp_auth_required == 1 |
| my @months2 = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec'); |
| || $smtp_auth_required == 4 ) |
| $smtpyear = qq~20$smtpyear~; |
| ) |
| $smtptimestring = qq~$days_short[$smtpwday], $smtpmday $months2[$smtpmon] $smtpyear $smtphour\:$smtpmin\:$smtpsec +0000~; |
| { |
| |
| send_line( "AUTH PLAIN %s\r\n", |
| # Fill the mail from field |
| encode_smtp64( "$authuser\0$authuser\0$authpass", q{} ) ); |
| &send_line ("MAIL FROM: <$smtp_from>\r\n"); |
| ( $code, $text, $more ) = get_line(); |
| ($code, $text, $more) = &get_line; |
| if ( $code != 235 && $smtp_auth_required != 4 ) { |
| # Add as many addressees as needed |
| fatal_error( 'smtp_error', |
| foreach (split(/, /, $smtp_to)) { |
| "[$code]: $smtp_txt{$code}<br /><br /><b>$smtp_txt{'5'}</b><br />$sendlog" |
| &send_line ("RCPT TO: <$_>\r\n"); |
| ); |
| ($code, $text, $more) = &get_line; |
| } |
| } |
| $auth_ok = 1; |
| |
| } |
| # Send message data |
| |
| &send_line ("DATA\r\n"); |
| # Decide to complain about advertised methods not supported. |
| ($code, $text, $more) = &get_line; |
| else { |
| &send_line ("To: $toheader\r\n"); |
| fatal_error( 'smtp_error', |
| &send_line ("Date: $smtptimestring\r\n"); |
| "$smtp_txt{'notsupported'}<br /><br /><b>$smtp_txt{'5'}</b><br />$sendlog" |
| &send_line ("From: $fromheader\r\n"); |
| ); |
| &send_line ("X-Mailer: YaBB SMTP\r\n"); |
| } |
| &send_line ("Subject: $smtp_subject\r\n"); |
| } |
| &send_line ("Content-Type: text/plain\; charset=$smtp_charset\r\n\r\n"); |
| |
| &send_line ("$smtp_message"); |
| # build the Date per RFC822 - uses gmtime to create date & time stamp |
| &send_line ("\r\n.\r\n"); |
| ( |
| |
| $smtpsec, $smtpmin, $smtphour, $smtpmday, $smtpmon, |
| # It is polite to close the door behind you |
| $smtpyear, $smtpwday, $smtpyday, $smtpisdst |
| &send_line ("QUIT\r\n"); |
| ) = gmtime( $date ); |
| if ($smtp_from eq ""){ $proto_error = "$smtp_txt{'no_from'}<br />"; } |
| $smtpyear = sprintf '%02d', ( $smtpyear - 100 ); |
| if ($smtp_to eq ""){ $proto_error .= "$smtp_txt{'no_to'}<br />"; } |
| $smtphour = sprintf '%02d', $smtphour; |
| if ($proto_error){ |
| $smtpmin = sprintf '%02d', $smtpmin; |
| &fatal_error("smtp_error","<br />$proto_error<br />$sendlog"); |
| $smtpsec = sprintf '%02d', $smtpsec; |
| } |
| my @months2 = qw( |
| return 1; |
| Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec |
| |
| ); |
| |
| $smtpyear = qq~20$smtpyear~; |
| |
| $smtptimestring = |
| |
| qq~$days_short[$smtpwday], $smtpmday $months2[$smtpmon] $smtpyear $smtphour\:$smtpmin\:$smtpsec +0000~; |
| |
| |
| |
| # Fill the mail from field |
| |
| send_line("MAIL FROM: <$smtp_from>\r\n"); |
| |
| ( $code, $text, $more ) = get_line(); |
| |
| |
| |
| # Add as many addressees as needed |
| |
| foreach ( split /,\ /xsm, $smtp_to ) { |
| |
| send_line("RCPT TO: <$_>\r\n"); |
| |
| ( $code, $text, $more ) = get_line(); |
| |
| } |
| |
| |
| |
| # Send message data |
| |
| send_line("DATA\r\n"); |
| |
| ( $code, $text, $more ) = get_line(); |
| |
| send_line("To: $toheader\r\n"); |
| |
| send_line("Date: $smtptimestring\r\n"); |
| |
| send_line("From: $fromheader\r\n"); |
| |
| send_line("X-Mailer: YaBB SMTP\r\n"); |
| |
| send_line("Subject: $smtp_subject\r\n"); |
| |
| send_line("Content-Type: text/html\; charset=$smtp_charset\r\n\r\n"); |
| |
| send_line("$smtp_message"); |
| |
| send_line("\r\n.\r\n"); |
| |
| |
| |
| # It is polite to close the door behind you |
| |
| send_line("QUIT\r\n"); |
| |
| if ( $smtp_from eq q{} ) { $proto_error = "$smtp_txt{'no_from'}<br />"; } |
| |
| if ( $smtp_to eq q{} ) { $proto_error .= "$smtp_txt{'no_to'}<br />"; } |
| |
| if ($proto_error) { |
| |
| fatal_error( 'smtp_error', "<br />$proto_error<br />$sendlog" ); |
| |
| } |
| |
| return 1; |
| } |
| } |
| |
| |
| # Get one line of response from the server. |
| # Get one line of response from the server. |
| sub get_line { |
| sub get_line { |
| my ($code, $sep, $text) = ($sock->getline() =~ /(\d+)(.)([^\r]*)/); |
| my ( $code, $sep, $text ) = ( $sock->getline() =~ /(\d+)(.)([^\r]*)/xsm ); |
| my $more; |
| my $more; |
| $code =~ s/ //g; |
| $code =~ s/ //gsm; |
| if ($sep eq "-") { $more = 1; } else { $more = 0; } |
| if ( $sep eq q{-} ) { $more = 1; } |
| $sendlog .= qq~S:$code $text $sep~; |
| else { $more = 0; } |
| $sendlog .= qq~<br />~; |
| $sendlog .= qq~S:$code $text $sep~; |
| return ($code, $text, $more); |
| $sendlog .= q~<br />~; |
| |
| return ( $code, $text, $more ); |
| } |
| } |
| |
| |
| |
| |
| # Send one line back to the server |
| # Send one line back to the server |
| sub send_line (@) { |
| sub send_line (@) { |
| my @args = @_; |
| my @args = @_; |
| # $args[0] =~ s/\n/\r\n/g; |
| |
| $sendlog .= qq~C:$args[0]~; |
| # $args[0] =~ s/\n/\r\n/gsm; |
| $sendlog =~ s/\r\n//g; |
| $sendlog .= qq~C:$args[0]~; |
| $sendlog .= qq~<br />~; |
| $sendlog =~ s/\r\n//gxsm; |
| $sock->printf (@args); |
| $sendlog .= q~<br />~; |
| |
| $sock->printf(@args); |
| |
| return; |
| } |
| } |
| |
| |
| # Helper function to encode CRAM-MD5 challenge |
| # Helper function to encode CRAM-MD5 challenge |
| sub encode_cram_md5 ($$$) { |
| sub encode_cram_md5 ($$$) { |
| my ($ticket64, $username, $password) = @_; |
| my ( $ticket64, $username, $password ) = @_; |
| my $ticket = decode_smtp64($ticket64) or |
| my $ticket = decode_smtp64($ticket64) |
| die ("Unable to decode Base64 encoded string '$ticket64'\n"); |
| or die "Unable to decode Base64 encoded string '$ticket64'\n"; |
| |
| |
| my $password_md5 = hmac_md5_hex($ticket, $password); |
| my $password_md5 = hmac_md5_hex( $ticket, $password ); |
| return encode_smtp64 ("$username $password_md5", ""); |
| return encode_smtp64( "$username $password_md5", q{} ); |
| } |
| } |
| |
| |
| sub encode_smtp64 { |
| sub encode_smtp64 { |
| if ($] >= 5.006) { |
| my ( $inp, $eol ) = @_; |
| require bytes; |
| if ( $] >= 5.006 ) { |
| if (bytes::length($_[0]) > length($_[0]) || |
| require bytes; |
| ($] >= 5.008 && $_[0] =~ /[^\0-\xFF]/)) |
| if ( bytes::length($inp) > length($inp) |
| { |
| || ( $] >= 5.008 && $inp =~ /[^\0-\xFF]/xsm ) ) |
| require Carp; |
| { |
| Carp::croak("The Base64 encoding is only defined for bytes"); |
| require Carp; |
| } |
| Carp::croak('The Base64 encoding is only defined for bytes'); |
| |
| } |
| } |
| } |
| require integer; |
| require integer; |
| import integer; |
| import integer; |
| my $eol = $_[1]; |
| if ( !$eol ) { $eol = "\n"; } |
| $eol = "\n" unless defined $eol; |
| |
| |
| my $res = pack 'u', $inp; |
| |
| |
| my $res = pack("u", $_[0]); |
| |
| # Remove first character of each line, remove newlines |
| # Remove first character of each line, remove newlines |
| $res =~ s/^.//mg; |
| $res =~ s/^.//gxsm; |
| $res =~ s/\n//g; |
| $res =~ s/\n//gxsm; |
| $res =~ tr|` -_|AA-Za-z0-9+/|; # `# help emacs |
| $res =~ tr|` -_|AA-Za-z0-9+/|; # `# help emacs |
| # fix padding at the end |
| # fix padding at the end |
| my $padding = (3 - length($_[0]) % 3) % 3; |
| my $padding = ( 3 - length($inp) % 3 ) % 3; |
| $res =~ s/.{$padding}$/'=' x $padding/e if $padding; |
| if ($padding) { $res =~ s/.{$padding}$/q{=} x $padding/exsm; } |
| |
| |
| # break encoded string into lines of no more than 76 characters each |
| # break encoded string into lines of no more than 76 characters each |
| if (length $eol) { |
| if ( length $eol ) { |
| $res =~ s/(.{1,76})/$1$eol/g; |
| $res =~ s/(.{1,76})/$1$eol/gxsm; |
| } |
| } |
| chomp $res; |
| chomp $res; |
| return $res; |
| return $res; |
| } |
| } |
| |
| |
| sub decode_smtp64 ($) |
| sub decode_smtp64 ($) { |
| { |
| local $WARNING = 0; # unpack("u",...) gives bogus warning in 5.00[123] |
| local($^W) = 0; # unpack("u",...) gives bogus warning in 5.00[123] |
| |
| require integer; |
| require integer; |
| import integer; |
| import integer; |
| |
| |
| my $str = shift; |
| my $str = shift; |
| $str =~ tr|A-Za-z0-9+=/||cd; # remove non-base64 chars |
| $str =~ tr|A-Za-z0-9+=/||cd; # remove non-base64 chars |
| # if (length($str) % 4) { |
| $str =~ s/=+$//xsm; # remove padding |
| # require Carp; |
| $str =~ tr|A-Za-z0-9+/| -_|; # convert to uuencoded format |
| # Carp::carp("Length of base64 data not a multiple of 4") |
| if ( !length $str ) { return q{}; } |
| # } |
| |
| $str =~ s/=+$//; # remove padding |
| my $uustr = q{}; |
| $str =~ tr|A-Za-z0-9+/| -_|; # convert to uuencoded format |
| my $l = length($str) - 60; |
| return "" unless length $str; |
| foreach my $i ( 0 .. $l ) { |
| |
| if ( $i % 60 == 0 ) { |
| ## I guess this could be written as |
| $uustr .= 'M' . substr $str, $i, 60; |
| #return unpack("u", join('', map( chr(32 + length($_)*3/4) . $_, |
| } |
| # $str =~ /(.{1,60})/gs) ) ); |
| |
| ## but I do not like that... |
| |
| my $uustr = ''; |
| |
| my ($i, $l); |
| |
| $l = length($str) - 60; |
| |
| for ($i = 0; $i <= $l; $i += 60) { |
| |
| $uustr .= "M" . substr($str, $i, 60); |
| |
| } |
| } |
| $str = substr($str, $i); |
| $str = substr $str, $i; |
| |
| |
| # and any leftover chars |
| # and any leftover chars |
| if ($str ne "") { |
| if ( $str ne q{} ) { |
| $uustr .= chr(32 + length($str)*3/4) . $str; |
| $uustr .= chr( 32 + length($str) * 3 / 4 ) . $str; |
| } |
| } |
| return unpack ("u", $uustr); |
| return unpack 'u', $uustr; |
| } |
| } |
| |
| |
| sub say_hello ($) { |
| sub say_hello ($) { |
| my ($hello_host) = $_[0]; |
| my ($hello_host) = @_; |
| my ($feat, $param); |
| my ( $feat, $param ); |
| #send RFC2821 compliant identifyer |
| |
| &send_line ("EHLO $hello_host\r\n"); |
| #send RFC2821 compliant identifier |
| ($code, $text, $more) = &get_line; |
| send_line("EHLO $hello_host\r\n"); |
| if($code != 250){ |
| ( $code, $text, $more ) = get_line(); |
| #try sending an old RFC281 compliant identifyer (older Exchange servers) |
| if ( $code != 250 ) { |
| &send_line ("HELO $hello_host\r\n"); |
| |
| } |
| #try sending an old RFC281 compliant identifier (older Exchange servers) |
| ($code, $text, $more) = &get_line; |
| send_line("HELO $hello_host\r\n"); |
| if($code == 250){ |
| } |
| &read_features(\%features); |
| ( $code, $text, $more ) = get_line(); |
| } |
| if ( $code == 250 ) { |
| return 1; |
| read_features( \%features ); |
| |
| } |
| |
| return 1; |
| } |
| } |
| |
| |
| sub read_features ($) { |
| sub read_features ($) { |
| my ($featref) = $_[0]; |
| my ($featref) = @_; |
| # Empty the hash |
| |
| %{$featref} = (); |
| # Empty the hash |
| ($feat, $param) = ($text =~ /^(\w+)[= ]*(.*)$/); |
| %{$featref} = (); |
| $featref->{$feat} = $param; |
| ( $feat, $param ) = ( $text =~ /^(\w+)[= ]*(.*)$/xsm ); |
| |
| $featref->{$feat} = $param; |
| # Load all features presented by the server into the hash |
| |
| while ($more == 1) { |
| # Load all features presented by the server into the hash |
| ($code, $text, $more) = &get_line; |
| while ( $more == 1 ) { |
| ($feat, $param) = ($text =~ /^(\w+)[= ]*(.*)$/); |
| ( $code, $text, $more ) = get_line(); |
| $featref->{$feat} = $param; |
| ( $feat, $param ) = ( $text =~ /^(\w+)[= ]*(.*)$/xsm ); |
| } |
| $featref->{$feat} = $param; |
| return 1; |
| } |
| |
| return 1; |
| } |
| } |
| |
| |
| 1; |
| 1; |
| |
| |