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

(-)a/C4/SIP/Sip.pm (-48 / +66 lines)
Lines 89-95 sub add_field { Link Here
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
- 

Return to bug 5586