"Fossies" - the Fresh Open Source Software archive

Member "sms.pl" of archive samsem-4.22b.tgz:


package sms;

#use Dumpvalue;
#my $dumper = new Dumpvalue;

# Package version 4.1b

# Functions provided:
#  $msg = map_chars($msg);
#  ($pdulen,$pdu) = encode_pdu($number,			destination addr.
#				[Class => $class,	0..5
#				Message => $msg,	user data
#				Coding => $coding,	DCS
#				Validity => $vp,	validity period
#				Status => $srr,		status report req.
#				SCA => $sca]);		service centre addr.
#  $msg = unmap_chars($msg);

sub encode_pdu {
	my ($class,$number,$msg,$coding,$vp,$ack,$sca) = @_;
	my ($pdu, $encoded_sca);

	$pdu = unpack("H2", pack("B8",
			"00".($ack?"1":"0").($vp?"10":"00")."001"));# PDU type
	$pdu .= "00";				# Dummy Message Reference

	my $type = ($number =~ /^\+/) ? "91" : "81";
	$number =~ s/\D//g;			# Delete non-digits
	$pdu .= sprintf("%.2X%s",length($number),$type);
	$number .= "F";				# For odd number of digits
	while ($number =~ /^(.)(.)(.*)$/) {	# Get pair of digits
		$pdu .= "$2$1";
		$number = $3;
	}

	$pdu .= "00";				# Protocol ID
	$pdu .= ($class =~ /([0-3])/) ? "F$1" : "00";	# Coding/Class

	if ($vp) {					# Validity Period
		my %t=(	'm' =>      60,
			'h' =>   3_600,
			'd' =>  86_400,
			'w' => 604_800,
		);
		$vp =~ /([\d\.]+)([mhdw])/i;
		$vp = $1 * $t{lc $2};		# VP measured in seconds
		if ($vp/$t{'w'} >= 5) {
			$vp = int($vp/$t{'w'})+192;
		}
		elsif ($vp/$t{'d'} >= 2) {
			$vp = 30 * $t{'d'}  if ($vp > 30 * $t{'d'});
			$vp = int($vp/$t{'d'})+166;
		}
		elsif ($vp/$t{'h'} >= 12.5) {
			$vp = 24 * $t{'h'}  if ($vp > 24 * $t{'h'});
			$vp = int(($vp-12*$t{'h'})/($t{'h'}/2))+143;
		}
		else {
			$vp = 720 * $t{'m'} if ($vp > 720 * $t{'m'});
			$vp = 5 * $t{'m'}   if ($vp < 5 * $t{'m'});
			$vp = int($vp/($t{'m'}*5))-1;
		}
		$pdu .= sprintf("%.2X",$vp);
	}

	$pdu .= sprintf("%.2X", length($msg));		# User Data Length
	$pdu .= encode_7bit(substr($msg,0,160));	# User Data

	if (defined $sca) {
		if ($sca) {
			$encoded_sca = ($sca =~ /^\+/) ? "91" : "81";
			$sca =~ s/\D//g;		# Delete non-digits
			$sca .= "F";			# For odd digits
			while ($sca =~ /^(.)(.)(.*)$/) {# Get pair of digits
				$encoded_sca .= "$2$1";
				$sca = $3;
			}
			$encoded_sca = sprintf("%.2X%s",
					length($encoded_sca)/2, $encoded_sca);
		}
		else {
			$encoded_sca = "00";
		}
	}
	else {
		$encoded_sca = "";
	}

	return wantarray ?
		(length($pdu)/2,$encoded_sca.$pdu) : $endcoded_sca.$pdu;
}

sub encode_7bit {
	my $msg = shift;
	my ($bits,$ud);
	foreach (split(//,$msg)) {
		$bits .= unpack('b7', $_);
	}
	while (length $bits) {
		$octet = substr($bits,0,8);
		$ud .= unpack("H2", pack("b8", substr($octet."0" x 7, 0, 8)));
		$bits = substr($bits,8);
	}
	return uc $ud;
}

sub map_chars {
	(my $retval = shift) =~ tr|\$\@|\x02\x00|;
	return $retval;
}

#			 +------0 DELIVER
#			 |+-----1 SUBMIT-REPORT
#			 ||+----2 STATUS-REPORT
#			 |||+---4 DELIVER-REPORT
#			 ||||+--5 SUBMIT
#			 |||||+-6 COMMAND
#  {			 ||||||  
#	MTI =>		#012456	Message Type Indicator
#	VPF =>		#    5	Validity Period Format
#	MMS =>		#0 2	More Messages To Send
#	RD =>		#    5	Reject Duplicates
#	RP =>		#0   5	Reply Path
#	UDHI =>		#012456	User Data Header Indicator
#	SRI =>		#0	Status Report Indication
#	SRR =>		#    56	Status Report Request
#	SRQ =>		#  2	Status Report Qualifier
#	OA =>		#0	Originating Address
#	DA =>		#    5	Destination Address
#	PID =>		#012456	Protocol Identifier
#	DCS =>		#01245	Data Coding Scheme
#	SCTS =>		#012	Service Centre Time Stamp
#	VP =>		#    5	Validity Period
#	UDL =>		#01245	User Data Length
#	UD =>		#01245	User Data
#	FCS =>		# 1 4	Failure Cause
#	PI =>		# 124 	Parameter Indicator
#	MR =>		#  2 56	Message Reference
#	RA =>		#  2	Recipient Address
#	DT =>		#  2	Discharge Time
#	ST =>		#  2	Status
#	CT =>		#     6 Command Type
#	MN =>		#     6 Message Number
#	CDL =>		#     6 Command Data Length
#	CD =>		#     6 Command Data
#	SCA =>		#	Service Center Address (not part of TPDU)
#  } = decode_pdu($pdu,$out,$nosca,$pdulen);
sub decode_pdu {
	my @pdu = split(//,shift);
	my ($out,$nosca,$pdulen) = @_;
	my $ret = {};

	if ($pdulen) {
		$nosca = ($pdulen == ($#pdu+1)/2);
	}

	unless ($nosca) {
		my $len = decode_int(\@pdu);
		if ($len) {
			my $type = decode_int(\@pdu);
			my $sca = decode_semi_octets(2*$len-2, \@pdu);
			$sca =~ s/(.*)F$/$1/i;
			$ret->{SCA} = text_address($type, $sca);
		}
	}

	my $pdu_type = decode_int(\@pdu);
	my $mti = ($pdu_type & 0x03) | ($out ? 0x04 : 0);
	if    ($mti == 0) { $ret->{MTI} = 'DELIVER'; }
	elsif ($mti == 1) { $ret->{MTI} = 'SUBMIT-REPORT'; }
	elsif ($mti == 2) { $ret->{MTI} = 'STATUS-REPORT'; }
	elsif ($mti == 3) { $ret->{MTI} = undef; }
	elsif ($mti == 4) { $ret->{MTI} = 'DELIVER-REPORT'; }
	elsif ($mti == 5) { $ret->{MTI} = 'SUBMIT'; }
	elsif ($mti == 6) { $ret->{MTI} = 'COMMAND'; }
	elsif ($mti == 7) { $ret->{MTI} = undef; }
	$ret->{MTI} or return $ret;		# unknown type

	if ($ret->{MTI} eq 'DELIVER') {
		$ret->{RP}   = $pdu_type & 0x80;
		$ret->{UDHI} = $pdu_type & 0x40;
		$ret->{SRI}  = $pdu_type & 0x20;
		$ret->{MMS}  = $pdu_type & 0x04;
		$ret->{OA}   = text_address(decode_address(\@pdu));
		$ret->{PID}  = decode_int(\@pdu);
		$ret->{DCS}  = decode_int(\@pdu);
		$ret->{SCTS} = text_abs_date(decode_semi_octets(14, \@pdu));
		$ret->{UDL}  = decode_int(\@pdu);
		$ret->{UD}   = join('',@pdu);
	}
	elsif ($ret->{MTI} eq 'SUBMIT-REPORT') {
		warn "SMS-SUBMIT-REPORT decoding is not implemented\n";
	}
	elsif ($ret->{MTI} eq 'STATUS-REPORT') {
		$ret->{UDHI} = $pdu_type & 0x40;
		$ret->{SRQ}  = $pdu_type & 0x20;
		$ret->{MMS}  = $pdu_type & 0x04;
		$ret->{MR}   = decode_int(\@pdu);
		$ret->{RA}   = text_address(decode_address(\@pdu));
		$ret->{SCTS} = text_abs_date(decode_semi_octets(14, \@pdu));
		$ret->{DT}   = text_abs_date(decode_semi_octets(14, \@pdu));
		$ret->{ST}   = decode_int(\@pdu);
		$ret->{PI}   = decode_int(\@pdu);
		$ret->{PID}  = decode_int(\@pdu);
		$ret->{DCS}  = decode_int(\@pdu);
		$ret->{UDL}  = decode_int(\@pdu);
		$ret->{UD}   = join('',@pdu);
	}
	elsif ($ret->{MTI} eq 'DELIVER-REPORT') {
		warn "SMS-DELIVER-REPORT decoding is not implemented\n";
	}
	elsif ($ret->{MTI} eq 'SUBMIT') {
		$ret->{RP}   = $pdu_type & 0x80;
		$ret->{UDHI} = $pdu_type & 0x40;
		$ret->{SRR}  = $pdu_type & 0x20;
		$ret->{VPF}  = $pdu_type & 0x18;
		$ret->{RD}   = $pdu_type & 0x04;
		$ret->{MR}   = decode_int(\@pdu);
		$ret->{DA}   = text_address(decode_address(\@pdu));
		$ret->{PID}  = decode_int(\@pdu);
		$ret->{DCS}  = decode_int(\@pdu);
		if ($ret->{VPF} == 0x10) {
			$ret->{VP} = text_rel_date(decode_int(\@pdu));
		}
		elsif ($ret->{VPF} == 0x18) {
			$ret->{VP} = text_abs_date(
					decode_semi_octets(14, \@pdu));
		}
		$ret->{UDL}  = decode_int(\@pdu);
		$ret->{UD}   = join('',@pdu);
	}
	elsif ($ret->{MTI} eq 'COMMAND') {
		$ret->{UDHI} = $pdu_type & 0x40;
		$ret->{SRR}  = $pdu_type & 0x20;
		$ret->{MR}   = decode_int(\@pdu);
		$ret->{PID}  = decode_int(\@pdu);
		$ret->{CT}   = decode_int(\@pdu);
		$ret->{MN}   = decode_int(\@pdu);
		$ret->{DA}   = text_address(decode_address(\@pdu));
		$ret->{CDL}  = decode_int(\@pdu);
		$ret->{CD}   = join('',@pdu);
	}
#$dumper->dumpValue($ret);
#print "--------------\n";
	return $ret;
}

sub text_ud {
	my ($coding, $udlen, $ud) = @_;
	my $msg;

	if ($coding == 0 or ($coding&0xf4) == 0xf0) {
		$msg = substr(decode_7bit($ud),0,$udlen);
	}
	elsif (($coding&0xf4) == 0xf4) {
		$msg = substr(decode_8bit($ud),0,$udlen);
	}
	else {
		warn "\nUnknown Data Coding Scheme $coding\n";
		$msg = '<--Cannot be decoded-->';
	}
	$msg;
}

sub decode_int {
	my $r = shift;
	my $retval = hex("$$r[0]$$r[1]");
	shift @$r; shift @$r;
	$retval;
}

sub decode_semi_octets {
	my ($len, $r) = @_;
	my $retval = '';
	while ($len > 0) {
		$retval .= $$r[1];
		$len--;
		$retval .= $$r[0] if ($len-->0);
		shift @$r; shift @$r;
        }
	$retval;
}

sub decode_address {
	my $r = shift;
	my $len = decode_int($r);
	(decode_int($r), decode_semi_octets($len, $r));
}

sub text_address {
	my ($type, $number) = @_;
	my $retval = "+" if ($type eq 0x91);
	$retval . $number;
}

sub text_abs_date {
	my $date = shift;
	return	substr($date, 0, 2) . "/" .
		substr($date, 2, 2) . "/" .
		substr($date, 4, 2) . " " .
		substr($date, 6, 2) . ":" .
		substr($date, 8, 2) . ":" .
		substr($date,10, 2);
}

sub text_rel_date {
	my $time = shift;
	my $retval;

	# convert time to minutes
	if    ($time<=143) { $time = ($time+1)*5; }
	elsif ($time<=167) { $time = 720+($time-143)*30; }
	elsif ($time<=196) { $time = ($time-166)*1_440; }
	else               { $time = ($time-192)*10_080; }

	# convert minutes to weeks, days and hours
	if ($time>=10_080) {
		$retval .= int($time/10_080)."w";
		$time = $time%10_080;
	}
	if ($time>=1_440) {
		$retval .= int($time/1_440)."d";
		$time = $time%1_440;
	}
	if ($time>=60) {
		$retval .= int($time/60)."h";
		$time = $time%60;
	}
	if ($time>0) {
		$retval .= $time."m";
	}
	$retval;
}

sub decode_7bit {
	my $ud = $_[0];
	my ($msg,$bits);
	while (length($ud)) {
		$bits .= unpack('b8',pack('H2',substr($ud,0,2)));
		$ud = substr($ud,2);
	}
	while ($bits =~ /^([01]{7})(.*)$/) {
		$msg .= pack('b7',$1);
		$bits = $2;
	}
	return $msg;
}

sub decode_8bit {
	my $ud = $_[0];
	my $msg;

	while (length($ud)) {
		$msg .= pack('H2',substr($ud,0,2));
		$ud = substr($ud,2);
	}
	return $msg;
}

sub unmap_chars {
	(my $retval = shift) =~ tr (\x00\x02) (\@\$);
# Change accented characters to their unaccented counterpart.
# This mapping may vary from country to country.
	$retval =~ tr (\x07\x0f\x7f\x04\x05\x1f\x5c\x7c\x5e\x7e)
		      (iaaeeEOoUu);
	return $retval;
}

%ceercause = (
1	=>	'Unassigned/unallocated number',
3	=>	'No route to destination',
6	=>	'Channel unacceptable',
8	=>	'Operator determined barring',
16	=>	'Normal call clearing',
17	=>	'User busy',
18	=>	'No user responding',
19	=>	'User alerting, no answer',
21	=>	'Call rejected',
22	=>	'Number changed',
26	=>	'Non selected user clearing',
27	=>	'Destination out of order',
28	=>	'Invalid number format (incomplete number)',
29	=>	'Facility rejected',
30	=>	'Response to STATUS ENQUIRY',
31	=>	'Normal, unsmecified',

34	=>	'No circuit/channel available',
38	=>	'Network out of order',
41	=>	'Temporary failure',
42	=>	'Switching equipment congestion',
43	=>	'Access information discarded',
44	=>	'Requested circuit/channel not available',
47	=>	'Resources unavailable, unspecified',

49	=>	'Quality of service unavailable',
50	=>	'Requested facility not subscribed',
55	=>	'Incoming call barred with the CUG',
57	=>	'Bearer capability not authorized',
58	=>	'Bearer capability not presently available',
63	=>	'Service or option not available, unspecified',

65	=>	'Bearer service not implemented',
68	=>	'ACM equal or greater than ACMmax',
69	=>	'Requested facility not implemented',
70	=>	'Only restricted digital information bearer capability is available',
79	=>	'Service or option not implemented, unspecified',

81	=>	'Invalid transaction identifier value',
87	=>	'User not member of CUG',
88	=>	'Incompatible destination',
91	=>	'Invalid transit network selection',
95	=>	'Semantically incorrect message',

96	=>	'Invalid mandatory information',
97	=>	'Message type non-existent or not implemented',
98	=>	'Message type not compatible with protocol state',
99	=>	'Information element non-existent or not implemented',
100	=>	'Conditional IE error',
101	=>	'Message not compatible with protocol state',
102	=>	'Recovery on time expire',
111	=>	'Protocol error, unspecified',

127	=>	'Internetworking, unspecified',

252	=>	'Call barring on outgoing calls',
253	=>	'Call barring on incoming calls',
254	=>	'Call impossible',
255	=>	'Lower layer failure',
);

%cmserror = (
1	=>	'Unassigned/unallocated number',
8	=>	'Operator determined barring',
10	=>	'Call barred',
21	=>	'Short message transfer rejected',
27	=>	'Destination out of service',
28	=>	'Unidentified subscriber',
29	=>	'Facility rejected',
30	=>	'Unknown subscriber',
38	=>	'Network out of order',
41	=>	'Temporary failure',
42	=>	'Congestion',
47	=>	'Resources unavailable, unspecified',
69	=>	'Requested facility not implemented',
81	=>	'Invalid short message transfer reference value',
95	=>	'Invalid message, unspecified',
96	=>	'Invalid mandatory information',
97	=>	'Message type non-existent or not implemented',
98	=>	'Message not compatible with short message protocol state',
99	=>	'Information element non-existent or not implemented',
111	=>	'Protocol error, unspecified',
127	=>	'Internetworking, unspecified',
300	=>	'ME failure',
301	=>	'SMS interface of ME reserved',
302	=>	'Operation not allowed',
303	=>	'Operation not supported',
304	=>	'Invalid PDU mode parameter',
305	=>	'Invalid text mode parameter',
310	=>	'SIM not inserted',
311	=>	'SIM PIN required',
312	=>	'Phone security code required',
313	=>	'SIM failure',
314	=>	'SIM busy',
315	=>	'SIM wrong',
316	=>	'SIM PUK required',
320	=>	'General memory error',
321	=>	'Invalid memory index',
322	=>	'SIM memory full',
330	=>	'SC address unknown',
331	=>	'No network service',
332	=>	'Network timeout',
500	=>	'Unknown error',
);

%cmeerror = (
0	=>	'Phone failure',
1	=>	'No connection to phone',
2	=>	'Transceiver-adapter link reserved',
3	=>	'Operation not allowed',
4	=>	'Operation not supported',
5	=>	'Phone security code required',
10	=>	'SIM not inserted',
11	=>	'SIM PIN required',
12	=>	'SIM PUK required',
13	=>	'SIM failure',
14	=>	'SIM busy',
15	=>	'SIM wrong',
16	=>	'Incorrect password',
17	=>	'SIM PIN2 required',
18	=>	'SIM PUK2 required',
20	=>	'Memory full',
21	=>	'Invalid memory index',
22	=>	'Not found',
23	=>	'General memory error',
24	=>	'Text string too long',
25	=>	'Invalid characters in text string',
26	=>	'Dial string too long',
27	=>	'Invalid characters in dial string',
30	=>	'No network service',
31	=>	'Network timeout',
100	=>	'Unknown error',
256	=>	'Protocol stack bad state',
257	=>	'Bad cell (not in the synchronized ones)',
258	=>	'Lost cell (doe to DSF...)',
);

%tpstatus = (
0	=>	'SM received by the SME',
1	=>	'SM forwarded by the SC to the SME but the SC is unable to confirm delivery',
2	=>	'Short message replaced by the SC',
32	=>	'Congestion',
33	=>	'SME busy',
34	=>	'No response from SME',
35	=>	'Service rejected',
36	=>	'Quality of service not available',
37	=>	'Error in SME',
64	=>	'Remote procedure error',
65	=>	'Incompatible destination',
66	=>	'Connection rejected by SME',
67	=>	'Not obtainable',
68	=>	'Quality of service not available',
69	=>	'No interworking available',
70	=>	'SM Validity Period Expired',
71	=>	'SM Deleted by originating SME',
72	=>	'SM Deleted by SC Administration',
73	=>	'SM does not exist',
);
1;