Attachment #2956 for bug #5586

View | Details | Raw Unified | Return to bug 5586
Collapse All | Expand All




#
# maybe_add(field_id, value):
#    If value is defined and non-empty, then return the
#    constructed field value, otherwise return the empty string.
#    NOTE: if zero is a valid value for your field, don't use maybe_add!
#
sub maybe_add {
    my ($fid, $value) = @_;

}


# read_SIP_packet($file)
#
# Read a packet from $file, using the correct record separator
#
sub read_SIP_packet {
    my $record;
    my $fh = shift or syslog("LOG_ERR", "read_SIP_packet: no filehandle argument!");
    my $len1 = 999;

    # local $/ = "\r";      # don't need any of these here.  use whatever the prevailing $/ is.
    local $/ = "\015";    # proper SPEC: (octal) \015 = (hex) x0D = (dec) 13 = (ascii) carriage return
    {    # adapted from http://perldoc.perl.org/5.8.8/functions/readline.html
        for ( my $tries = 1 ; $tries <= 3 ; $tries++ ) {
            undef $!;
            $record = readline($fh);
            if ( defined($record) ) {
                while ( chomp($record) ) { 1; }
                $len1 = length($record);
                syslog( "LOG_DEBUG", "read_SIP_packet, INPUT MSG: '$record'" );
                $record =~ s/^\s*[^A-z0-9]+//s; # Every line must start with a "real" character.  Not whitespace, control chars, etc. 
                $record =~ s/[^A-z0-9]+$//s;    # Same for the end.  Note this catches the problem some clients have sending empty fields at the end, like |||
                $record =~ s/\015?\012//g;      # Extra line breaks must die
                $record =~ s/\015?\012//s;      # Extra line breaks must die
                $record =~ s/\015*\012*$//s;    # treat as one line to include the extra linebreaks we are trying to remove!
                while ( chomp($record) ) { 1; }

                $record and last;    # success
            } else {
                if ($!) {
                    syslog( "LOG_DEBUG", "read_SIP_packet (try #$tries) ERROR: $! $@" );
                    # die "read_SIP_packet ERROR: $!";
                    warn "read_SIP_packet ERROR: $! $@";
                }
            }
        }
    }
    if ($record) {
        my $len2 = length($record);
        syslog("LOG_INFO", "read_SIP_packet, INPUT MSG: '$record'") if $record;
        ($len1 != $len2) and syslog("LOG_DEBUG", "read_SIP_packet, trimmed %s character(s) (after chomps).", $len1-$len2);
    } else {
        syslog("LOG_WARNING", "read_SIP_packet input %s, end of input.", (defined($record) ? "empty ($record)" : 'undefined'));
    }
    #
    # Cen-Tec self-check terminals transmit '\r\n' line terminators.
    # This is actually very hard to deal with in perl in a reasonable
    # since every OTHER piece of hardware out there gets the protocol
    # right.
    # 
    # The incorrect line terminator presents as a \r at the end of the
    # first record, and then a \n at the BEGINNING of the next record.
    # So, the simplest thing to do is just throw away a leading newline
    # on the input.
    #  
    # This is now handled by the vigorous cleansing above.
    # syslog("LOG_INFO", encode_utf8("INPUT MSG: '$record'")) if $record;
    syslog("LOG_INFO", "INPUT MSG: '$record'") if $record;
    return $record;
}


    my ($self, $msg, $file) = @_;
    my $cksum;

    # $msg = encode_utf8($msg);
    if ($error_detection) {
        if (defined($self->{seqno})) {
            $msg .= 'AY' . $self->{seqno};
        }
        $msg .= 'AZ';
        $cksum = checksum($msg);
        $msg .= sprintf('%04.4X', $cksum);
    }


    if ($file) {
        print $file "$msg\r";
		syslog("LOG_DEBUG", "write_msg outputting to $file");
    } else {
        print "$msg\r";
        syslog("LOG_INFO", "OUTPUT MSG: '$msg'");
    }
	syslog("LOG_INFO", "OUTPUT MSG: '$msg'");

    $last_response = $msg;
}
- 

Return to bug 5586

Lines 89-95 sub add_field { Link Here

(-)a/C4/SIP/Sip.pm (-48 / +66 lines)
89	#	89	#
90	# maybe_add(field_id, value):	90	# maybe_add(field_id, value):
91	# If value is defined and non-empty, then return the	91	# If value is defined and non-empty, then return the
92	# constructed field value, otherwise return the empty string	92	# constructed field value, otherwise return the empty string.
		93	# NOTE: if zero is a valid value for your field, don't use maybe_add!
93	#	94	#
94	sub maybe_add {	95	sub maybe_add {
95	my ($fid, $value) = @_;	96	my ($fid, $value) = @_;
Lines 146-191 sub boolspace { Link Here
146	}	147	}
147		148
148		149
		150	# read_SIP_packet($file)
		151	#
149	# Read a packet from $file, using the correct record separator	152	# Read a packet from $file, using the correct record separator
150	#	153	#
151	sub read_SIP_packet {	154	sub read_SIP_packet {
152	my $record;	155	my $record;
153	my $fh = shift or syslog("LOG_ERR", "read_SIP_packet: no filehandle argument!");	156	my $fh = shift or syslog("LOG_ERR", "read_SIP_packet: no filehandle argument!");
154	my $len1 = 999;	157	my $len1 = 999;
155	# local $/ = "\012"; # Internet Record Separator (lax version)	158
156	{ # adapted from http://perldoc.perl.org/5.8.8/functions/readline.html	159	# local $/ = "\r"; # don't need any of these here. use whatever the prevailing $/ is.
157	for (my $tries=1; $tries<=3; $tries++) {	160	local $/ = "\015"; # proper SPEC: (octal) \015 = (hex) x0D = (dec) 13 = (ascii) carriage return
158	undef $!;	161	{ # adapted from http://perldoc.perl.org/5.8.8/functions/readline.html
159	$record = readline($fh);	162	for ( my $tries = 1 ; $tries <= 3 ; $tries++ ) {
160	if (defined($record)) {	163	undef $!;
161	while(chomp($record)){1;}	164	$record = readline($fh);
162	$len1 = length($record);	165	if ( defined($record) ) {
163	syslog("LOG_DEBUG", "read_SIP_packet, INPUT MSG: '$record'");	166	while ( chomp($record) ) { 1; }
164	$record =~ s/^\s*[^A-z0-9]+//s;	167	$len1 = length($record);
165	$record =~ s/[^A-z0-9]+$//s;	168	syslog( "LOG_DEBUG", "read_SIP_packet, INPUT MSG: '$record'" );
166	$record =~ s/\015?\012//g;	169	$record =~ s/^\s*[^A-z0-9]+//s; # Every line must start with a "real" character. Not whitespace, control chars, etc.
167	$record =~ s/\015?\012//s;	170	$record =~ s/[^A-z0-9]+$//s; # Same for the end. Note this catches the problem some clients have sending empty fields at the end, like \|\|\|
168	$record =~ s/\015\012$//s; # treat as one line to include the extra linebreaks we are trying to remove!	171	$record =~ s/\015?\012//g; # Extra line breaks must die
169	while(chomp($record)){1;}	172	$record =~ s/\015?\012//s; # Extra line breaks must die
170	if ($record) {	173	$record =~ s/\015\012$//s; # treat as one line to include the extra linebreaks we are trying to remove!
171	last; # success	174	while ( chomp($record) ) { 1; }
172	}	175
173	} else {	176	$record and last; # success
174	if ($!) {	177	} else {
175	syslog("LOG_DEBUG", "read_SIP_packet (try #$tries) ERROR: $!");	178	if ($!) {
176	# die "read_SIP_packet ERROR: $!";	179	syslog( "LOG_DEBUG", "read_SIP_packet (try #$tries) ERROR: $! $@" );
177	warn "read_SIP_packet ERROR: $!";	180	# die "read_SIP_packet ERROR: $!";
178	}	181	warn "read_SIP_packet ERROR: $! $@";
179	}	182	}
180	}	183	}
181	}	184	}
182	if ($record) {	185	}
183	my $len2 = length($record);	186	if ($record) {
184	syslog("LOG_INFO", "read_SIP_packet, INPUT MSG: '$record'") if $record;	187	my $len2 = length($record);
185	($len1 != $len2) and syslog("LOG_DEBUG", "read_SIP_packet, trimmed %s character(s) (after chomps).", $len1-$len2);	188	syslog("LOG_INFO", "read_SIP_packet, INPUT MSG: '$record'") if $record;
186	} else {	189	($len1 != $len2) and syslog("LOG_DEBUG", "read_SIP_packet, trimmed %s character(s) (after chomps).", $len1-$len2);
187	syslog("LOG_WARNING", "read_SIP_packet input %s, end of input.", (defined($record)? "empty ($record)" : 'undefined'));	190	} else {
188	}	191	syslog("LOG_WARNING", "read_SIP_packet input %s, end of input.", (defined($record) ? "empty ($record)" : 'undefined'));
		192	}
		193	#
		194	# Cen-Tec self-check terminals transmit '\r\n' line terminators.
		195	# This is actually very hard to deal with in perl in a reasonable
		196	# since every OTHER piece of hardware out there gets the protocol
		197	# right.
		198	#
		199	# The incorrect line terminator presents as a \r at the end of the
		200	# first record, and then a \n at the BEGINNING of the next record.
		201	# So, the simplest thing to do is just throw away a leading newline
		202	# on the input.
		203	#
		204	# This is now handled by the vigorous cleansing above.
		205	# syslog("LOG_INFO", encode_utf8("INPUT MSG: '$record'")) if $record;
		206	syslog("LOG_INFO", "INPUT MSG: '$record'") if $record;
189	return $record;	207	return $record;
190	}	208	}
191		209
Lines 204-225 sub write_msg { Link Here
204	my ($self, $msg, $file) = @_;	222	my ($self, $msg, $file) = @_;
205	my $cksum;	223	my $cksum;
206		224
		225	# $msg = encode_utf8($msg);
207	if ($error_detection) {	226	if ($error_detection) {
208	if (defined($self->{seqno})) {	227	if (defined($self->{seqno})) {
209	$msg .= 'AY' . $self->{seqno};	228	$msg .= 'AY' . $self->{seqno};
210	}	229	}
211	$msg .= 'AZ';	230	$msg .= 'AZ';
212	$cksum = checksum($msg);	231	$cksum = checksum($msg);
213	$msg .= sprintf('%04.4X', $cksum);	232	$msg .= sprintf('%04.4X', $cksum);
214	}	233	}
215		234
		235
216	if ($file) {	236	if ($file) {
217	print $file "$msg$CRLF";	237	print $file "$msg\r";
218	syslog("LOG_DEBUG", "write_msg outputting to $file");
219	} else {	238	} else {
220	print "$msg$CRLF";	239	print "$msg\r";
		240	syslog("LOG_INFO", "OUTPUT MSG: '$msg'");
221	}	241	}
222	syslog("LOG_INFO", "OUTPUT MSG: '$msg'");
223		242
224	$last_response = $msg;	243	$last_response = $msg;
225	}	244	}
226	-