#!/usr/bin/perl
# Forward CA OES EDIS warnings affecting Santa Clara County to SVWUX EDIS list.
# Since OES e-mails are so incomplete, they are mainly used as a trigger to
# retrieve the Common Alerting Protocol (CAP) XML record from OES's web site.
# Then more filtering can be done to eliminate messages inappropriately marked
# with a statewide distribution.  Keeping it on-topic will help make it more
# useful to local users.
#
# written by Ian Kluft
# for the Silicon Valley Wireless Users and eXperimenters (SVWUX)

use strict;
use MIME::Parser;
use Text::Wrapper;
use LWP::UserAgent;
use XML::Parser;
use XML::Atom::Client;
use XML::Atom::Feed;
use XML::Atom::Entry;
use MIME::Lite;

# configuration
my $VERSION = "0.2";
my $debug = (( exists $ENV{DEBUG} ) and $ENV{DEBUG});
my $tmpdir = (( exists $ENV{TMPDIR} ) and $ENV{TMPDIR})
        ? $ENV{TMPDIR} : "/var/tmp";
my $exim_cmd = "/usr/sbin/exim";
my $list_name = "edis";
my $to_addr = ( ! $debug ) ? ( "mail.list.address\@your.domain" ) : ( "debug.address\@your.domain );
my $error_addr = "tech-address\@your.domain";
my $edis_atom_uri = "http://edis.oes.ca.gov/index.atom";
my %region = ( # for recognition of the local region
	areacodes => { 408 => 1, 650 => 1, 831 => 1, 510 => 1, 925 => 1 },
	counties => { "santa clara" => 1, "alameda" => 1, "san mateo" => 1,
		"santa cruz" => 1, "san benito" => 1 },
	cities => { "alameda" => 1, "albany" => 1, "atherton" => 1,
		"belmont" => 1, "berkeley" => 1, "brisbane" => 1,
		"burlingame" => 1, "campbell" => 1, "capitola" => 1,
		"colma" => 1, "cupertino" => 1, "daly city" => 1,
		"dublin" => 1, "east palo alto" => 1, "emeryville" => 1,
		"foster city" => 1, "fremont" => 1, "gilroy" => 1,
		"half moon bay" => 1, "hayward" => 1, "hillsborough" => 1,
		"hollister" => 1, "livermore" => 1, "los altos" => 1,
		"los altos hills" => 1, "los gatos" => 1, "menlo park" => 1,
		"millbrae" => 1, "milpitas" => 1, "monte sereno" => 1,
		"morgan hill" => 1, "mountain view" => 1, "newark" => 1,
		"oakland" => 1, "pacifica" => 1, "palo alto" => 1,
		"piedmont" => 1, "pleasanton" => 1, "portola valley" => 1,
		"redwood city" => 1, "san bruno" => 1, "san carlos" => 1,
		"san jose" => 1, "san juan bautista" => 1, "san leandro" => 1,
		"san mateo" => 1, "santa clara" => 1, "santa cruz" => 1,
		"saratoga" => 1, "scotts valley" => 1,
		"south san francisco" => 1, "sunnyvale" => 1,
		"union city" => 1, "watsonville" => 1, "woodside" => 1,
	},
);
my %state = ( # comprehensive lists for the state
	counties => [
		"alameda", "alpine", "amador", "butte", "calaveras", "colusa",
		"contra costa", "del norte", "el dorado", "fresno", "glenn",
		"humboldt", "imperial", "inyo", "kern", "kings", "lake",
		"lassen", "los angeles", "madera", "marin", "mariposa",
		"mendocino", "merced", "modoc", "mono", "monterey", "napa",
		"nevada", "orange", "placer", "plumas", "riverside",
		"sacramento", "san benito", "san bernardino", "san diego",
		"san francisco", "san joaquin", "san luis obispo", "san mateo",
		"santa barbara", "santa clara", "santa cruz", "shasta",
		"sierra", "siskiyou", "solano", "sonoma", "stanislaus",
		"sutter", "tehama", "trinity", "tulare", "tuolumne",
		"ventura", "yolo", "yuba",
	],
	cities => [
		"Adelanto", "Agoura Hills", "Alameda", "Albany", "Alhambra",
		"Aliso Viejo", "Alturas", "Amador", "American Canyon",
		"Anaheim", "Anderson", "Angels Camp", "Antioch",
		"Apple Valley", "Arcadia", "Arcata", "Arroyo Grande",
		"Artesia", "Arvin", "Atascadero", "Atherton", "Atwater",
		"Auburn", "Avalon", "Avenal", "Azusa", "Bakersfield",
		"Baldwin Park", "Banning", "Barstow", "Beaumont", "Bell",
		"Bell Gardens", "Bellflower", "Belmont", "Belvedere",
		"Benicia", "Berkeley", "Beverly Hills", "Big Bear Lake",
		"Biggs", "Bishop", "Blue Lake", "Blythe", "Bradbury",
		"Brawley", "Brea", "Brentwood", "Brisbane", "Buellton",
		"Buena Park", "Burbank", "Burlingame", "Calabasas",
		"Calexico", "California City", "Calimesa", "Calipatria",
		"Calistoga", "Camarillo", "Campbell", "Canyon Lake",
		"Capitola", "Carlsbad", "Carmel-by-the-Sea", "Carpinteria",
		"Carson", "Cathedral City", "Ceres", "Cerritos", "Chico",
		"Chino", "Chino Hills", "Chowchilla", "Chula Vista",
		"Citrus Heights", "Claremont", "Clayton", "Clearlake",
		"Cloverdale", "Clovis", "Coachella", "Coalinga", "Colfax",
		"Colma", "Colton", "Colusa", "Commerce", "Compton", "Concord",
		"Corcoran", "Corning", "Corona", "Coronado", "Corte Madera",
		"Costa Mesa", "Cotati", "Covina", "Crescent City", "Cudahy",
		"Culver City", "Cupertino", "Cypress", "Daly City",
		"Dana Point", "Danville", "Davis", "Del Mar", "Del Rey Oaks",
		"Delano", "Desert Hot Springs", "Diamond Bar", "Dinuba",
		"Dixon", "Dorris", "Dos Palos", "Downey", "Duarte", "Dublin",
		"Dunsmuir", "East Palo Alto", "El Cajon", "El Centro",
		"El Cerrito", "El Monte", "El Segundo", "Elk Grove",
		"Emeryville", "Encinitas", "Escalon", "Escondido", "Etna",
		"Eureka", "Exeter", "Fairfax", "Fairfield", "Farmersville",
		"Ferndale", "Fillmore", "Firebaugh", "Folsom", "Fontana",
		"Fort Bragg", "Fort Jones", "Fortuna", "Foster City",
		"Fountain Valley", "Fowler", "Fremont", "Fresno", "Fullerton",
		"Galt", "Garden Grove", "Gardena", "Gilroy", "Glendale",
		"Glendora", "Goleta", "Gonzales", "Grand Terrace",
		"Grass Valley", "Greenfield", "Gridley", "Grover Beach",
		"Guadalupe", "Gustine", "Half Moon Bay", "Hanford",
		"Hawaiian Gardens", "Hawthorne", "Hayward", "Healdsburg",
		"Hemet", "Hercules", "Hermosa Beach", "Hesperia",
		"Hidden Hills", "Highland", "Hillsborough", "Hollister",
		"Holtville", "Hughson", "Huntington Beach", "Huntington Park",
		"Huron", "Imperial", "Imperial Beach", "Indian Wells",
		"Indio", "Industry", "Inglewood", "Ione", "Irvine",
		"Irwindale", "Isleton", "Jackson", "Kerman", "King City",
		"Kingsburg", "La Canada Flintridge", "La Habra",
		"La Habra Heights", "La Mesa", "La Mirada", "La Palma",
		"La Puente", "La Quinta", "La Verne", "Lafayette",
		"Laguna Beach", "Laguna Hills", "Laguna Niguel",
		"Laguna Woods", "Lake Elsinore", "Lake Forest", "Lakeport",
		"Lakewood", "Lancaster", "Larkspur", "Lathrop", "Lawndale",
		"Lemon Grove", "Lemoore", "Lincoln", "Lindsay", "Live Oak",
		"Livermore", "Livingston", "Lodi", "Loma Linda", "Lomita",
		"Lompoc", "Long Beach", "Loomis", "Los Alamitos", "Los Altos",
		"Los Altos Hills", "Los Angeles", "Los Banos", "Los Gatos",
		"Loyalton", "Lynwood", "Madera", "Malibu", "Mammoth Lakes",
		"Manhattan Beach", "Manteca", "Maricopa", "Marina",
		"Martinez", "Marysville", "Maywood", "McFarland", "Mendota",
		"Menlo Park", "Merced", "Mill Valley", "Millbrae", "Milpitas",
		"Mission Viejo", "Modesto", "Monrovia", "Montague",
		"Montclair", "Monte Sereno", "Montebello", "Monterey",
		"Monterey Park", "Moorpark", "Moraga", "Moreno Valley",
		"Morgan Hill", "Morro Bay", "Mountain View", "Mount Shasta",
		"Murrieta", "Napa", "National City", "Needles", "Nevada City",
		"Newark", "Newman", "Newport Beach", "Norco", "Norwalk",
		"Novato", "Oakdale", "Oakland", "Oakley", "Oceanside", "Ojai",
		"Ontario", "Orange", "Orange Cove", "Orinda", "Orland",
		"Oroville", "Oxnard", "Pacific Grove", "Pacifica",
		"Palm Desert", "Palm Springs", "Palmdale", "Palo Alto",
		"Palos Verdes Estates", "Paradise", "Paramount", "Parlier",
		"Pasadena", "Paso Robles", "Patterson", "Perris", "Petaluma",
		"Pico Rivera", "Piedmont", "Pinole", "Pismo Beach",
		"Pittsburg", "Placentia", "Placerville", "Pleasant Hill",
		"Pleasanton", "Plymouth", "Point Arena", "Pomona",
		"Port Hueneme", "Porterville", "Portola", "Portola Valley",
		"Poway", "Rancho Cordova", "Rancho Cucamonga", "Rancho Mirage",
		"Rancho Palos Verdes", "Rancho Santa Margarita", "Red Bluff",
		"Redding", "Redlands", "Redondo Beach", "Redwood City",
		"Reedley", "Rialto", "Richmond", "Ridgecrest", "Rio Dell",
		"Rio Vista", "Ripon", "Riverbank", "Riverside", "Rocklin",
		"Rohnert Park", "Rolling Hills", "Rolling Hills Estates",
		"Rosemead", "Roseville", "Ross", "Sacramento", "Salinas",
		"San Anselmo", "San Bernardino", "San Bruno", "San Carlos",
		"San Clemente", "San Diego", "San Dimas", "San Fernando",
		"San Francisco", "San Gabriel", "San Jacinto", "San Joaquin",
		"San Jose", "San Juan Bautista", "San Juan Capistrano",
		"San Leandro", "San Luis Obispo", "San Marcos", "San Marino",
		"San Mateo", "San Pablo", "San Rafael", "San Ramon",
		"Sand City", "Sanger", "Santa Ana", "Santa Barbara",
		"Santa Clara", "Santa Clarita", "Santa Cruz",
		"Santa Fe Springs", "Santa Maria", "Santa Monica",
		"Santa Paula", "Santa Rosa", "Santee", "Saratoga",
		"Sausalito", "Scotts Valley", "Seal Beach", "Seaside",
		"Sebastopol", "Selma", "Shafter", "Shasta Lake",
		"Sierra Madre", "Signal Hill", "Simi Valley", "Solana Beach",
		"Soledad", "Solvang", "Sonoma", "Sonora", "South El Monte",
		"South Gate", "South Lake Tahoe", "South Pasadena",
		"South San Francisco", "St. Helena", "Stanton", "Stockton",
		"Suisun City", "Sunnyvale", "Susanville", "Sutter Creek",
		"Taft", "Tehachapi", "Tehama", "Temecula", "Temple City",
		"Thousand Oaks", "Tiburon", "Torrance", "Tracy", "Trinidad",
		"Truckee", "Tulare", "Tulelake", "Turlock", "Tustin",
		"Twentynine Palms", "Ukiah", "Union City", "Upland",
		"Vacaville", "Vallejo", "Ventura", "Vernon", "Victorville",
		"Villa Park", "Visalia", "Vista", "Walnut", "Walnut Creek",
		"Wasco", "Waterford", "Watsonville", "Weed", "West Covina",
		"West Hollywood", "West Sacramento", "Westlake Village",
		"Westminster", "Westmorland", "Wheatland", "Whittier",
		"Wildomar", "Williams", "Willits", "Willows", "Windsor",
		"Winters", "Woodlake", "Woodland", "Woodside", "Yorba Linda",
		"Yountville", "Yreka", "Yuba City", "Yucaipa", "Yucca Valley",
	],
);

# globals
my $mode = 1;
my @warning_text;
my $oes_sent_str;
my $oes_area_str;

#
# functions
#

# print debugging statements
sub debug
{
        $debug and print STDERR "debug: ".join("",@_)."\n";
}

# checkif statewide alert appears not to be of local interest
# 1) content has phone numbers and none are local
# 2) content has names of counties and none are local
# returns 1 = distance violation, 0 = no violation found
sub distance_violation
{
	my @content = shift;
	my $content = lc(join ( " ", @content ));

	# check phone numbers
	my %ac_found;
	my $phone_found = 0; # phone numbers found
	while ( $content =~ /\(([0-9]{3})\)\s*[0-9]{3}-[0-9]{4}/g ) {
		$ac_found{$1} = 1;
		$phone_found = 1;
	}
	while ( $content =~ /([0-9]{3})-[0-9]{3}-[0-9]{4}/g ) {
		$ac_found{$1} = 1;
		$phone_found = 1;
	}
	while ( $content =~ /([0-9]{3}) [0-9]{3} [0-9]{4}/g ) {
		$ac_found{$1} = 1;
		$phone_found = 1;
	}
	foreach my $ac ( sort keys %ac_found ) {
		if (( defined $region{areacodes}{$ac})
			and $region{areacodes}{$ac})
		{
			# stop: found a phone number in the local region
			debug "phone OK";
			return 0;
		}
	}

	# check counties
	my $county_found = 0;
	foreach my $county ( @{$state{counties}} ) {
		if ( $content =~ /$county county/i
			or $content =~ /$county sheriff/i )
		{
			$county_found = 1;
			if (( defined $region{counties}{$county})
				and $region{counties}{$county})
			{
				# stop: found a county in the local region
				debug "county OK";
				return 0;
			}
		}
	}

	# check cities
	my $city_found = 0;
	foreach my $city ( @{$state{cities}} ) {
		if ( $content =~ /city of $city/i
			or $content =~ /$city city/i
			or $content =~ /$city, ca[^\W]/i
			or $content =~ /$city, california/i
			or $content =~ /$city police/i )
		{
			$city_found = 1;
			if (( defined $region{cities}{$city})
				and $region{cities}{$city})
			{
				# stop: found a county in the local region
				debug "city OK";
				return 0;
			}
		}
	}

	# check for violations 
	if ( $phone_found or $county_found or $city_found ) {
		# if we got here with anything found, must be a violation
		# otherwise we'd have returned 0 earlier
		debug "distance violation phone:$phone_found "
			."county:$county_found city:$city_found";
		return 1;
	}

	# otherwise no violation
	debug "no distance indication, assume OK";
	return 0;
}

# build a CAP tree by recursion into an XML parse tree
sub build_cap_tree
{
	my $cap = shift;
	my $xml = shift;
	my $name = shift;

	debug "build_cap_tree("
		.(ref $cap).", ".(ref $xml).", ".(ref $name).")";

	#
	# scan a level of the XML parse tree
	#

	# skip initial hash ref for attributes - CAP doesn't use them
	my $i = ( ref $xml->[0] eq "HASH" ) ? 1 : 0;

	# loop through array representing contents of an XML tag
	for ( ; $i < scalar @$xml; $i += 2 ) {
		debug "$i: $xml->[$i]";
		if ( $xml->[$i] eq "alert" ) {
			# alert: the top-level structure
			# just descend into it - the $cap tree is for it
			debug "alert";
			build_cap_tree( $cap, $xml->[$i+1]);

		} elsif ( $xml->[$i] eq "0" ) {
			# process a text string

			# skip entries which are all whitespace
			$xml->[$i+1] =~ s/^\s*//smg; # leading whitespace
			$xml->[$i+1] =~ s/\s*$//smg; # trailing whitespace
			if ( length($xml->[$i+1]) == 0 ) {
				next;
			}

			# save text
			if ( defined $name ) {
				debug $name.": ".$xml->[$i+1];
				$cap->{$name} = $xml->[$i+1];
			} else {
				debug "name undefined - cannot save string $xml->[$i+1] (element ".($i+1)." of ".join("/",@$xml).")";
			}

		} elsif ( $xml->[$i] eq "info" ) {
			# info: create list of subtrees
			debug $xml->[$i];
			if ( !exists $cap->{$xml->[$i]}) {
				$cap->{$xml->[$i]} = [];
			}
			my $subtree = {};
			build_cap_tree( $subtree, $xml->[$i+1] );
			push @{$cap->{$xml->[$i]}}, $subtree;

		} elsif (( $xml->[$i] eq "resource" )
			or ( $xml->[$i] eq "area" ))
		{
			# resource and area: create subtree
			debug $xml->[$i];
			my $subtree = {};
			build_cap_tree( $subtree, $xml->[$i+1] );
			$cap->{$xml->[$i]} = $subtree;

		} elsif ( $xml->[$i] eq "eventCode"
			or $xml->[$i] eq "parameter"
			or $xml->[$i] eq "geoCode" )
		{
			# handle data types with name/value pairs
			debug $xml->[$i];
			if ( !exists $cap->{$xml->[$i]}) {
				$cap->{$xml->[$i]} = {};
			}

			# scan parameter tree to get valueName and value
			my $param = {};
			build_cap_tree( $param, $xml->[$i+1] );
			if (( exists $param->{valueName})
				and ( exists $param->{value}))
			{
				my $vname = $param->{valueName};
				my $value = $param->{value};
				debug $xml->[$i].": $vname = $value";
				$cap->{$xml->[$i]}{$vname} = $value;
			} else {
				debug "value/valueName not found in $name";
			}

		} elsif ( ref $xml->[$i] ) {
			debug "error - want tag name, got ".$xml->[$i];

		} else {
			# other tags are expected to contain just a string
			debug $xml->[$i];
			build_cap_tree( $cap, $xml->[$i+1], $xml->[$i]);
		}
	}
}

# fetch a Common Alerting Protocol record from a URL
sub fetch_cap
{
	my $url = shift;

	my $ua = LWP::UserAgent->new;
	$ua->agent("svwux-edis-mail/".$VERSION);
	my $req = HTTP::Request->new( GET => $url );
	my $res = $ua->request($req);
	if ($res->is_success) {
		# transcribe data to cap record and return it
		my $content = $res->content;
		my $p = XML::Parser->new(Style => 'Tree');
		my $xml = $p->parse( $content );
		my $cap = {};
		build_cap_tree ( $cap, $xml );
		return ( $cap, $content );
	} else {
		return undef;
	}
}

# convert CAP info block to text report
sub info2text
{
	my $info = shift;
	my $text;
	my $wrapper = Text::Wrapper->new( columns => 76 );

	$text = $wrapper->wrap(
		(( exists $info->{headline}) ? $info->{headline}."\n\n" : "" )
		.(( exists $info->{description}) ? $info->{description}."\n\n" : "" )
		.(( exists $info->{instruction}) ? $info->{instruction}."\n\n" : "" )
		.(( exists $info->{area}{areaDesc}) ? "Area: ".$info->{area}{areaDesc}."\n\n" : "" )
		.(( exists $info->{senderName}) ? "Sender: ".$info->{senderName}."\n" : "" )
		.(( exists $info->{expires}) ? "Expires: ".$info->{expires}."\n" : "" )
		.(( exists $info->{urgency}) ? "Urgency: ".$info->{urgency}."\n" : "" )
		.(( exists $info->{severity}) ? "Severity: ".$info->{severity}."\n" : "" )
		.(( exists $info->{certainty}) ? "Certainty: ".$info->{certainty}."\n" : "" )
		.(( exists $info->{category}) ? "Category: ".$info->{category}."\n" : "" )
		);
	return $text;
}

#
# receive e-mail message from STDIN
#

# chdir to temp directory
chdir ( $tmpdir );

# read mail from stdin
my $parser = new MIME::Parser;
my $entity = $parser->parse(\*STDIN) or die "parse failed\n";
my $headers = $entity->head;
my $body = $entity->bodyhandle;

# collect info from headers
my $subject = $headers->get('Subject');
$subject =~ s/\s*$//; # strip trailing spaces
my $date = $headers->get('Date');
$date =~ s/\s*$//; # strip trailing spaces

# parse the message
my $IO = $body->open("r");
my $line;
while ( defined($line = $IO->getline)) {
	chomp;
	$line =~ s/\s*$//; # strip trailing spaces
	debug "got: $line";

	if ( $mode == 1 ) {
		if ( $line =~ /This is a test message for/ ) {
			# do not forward test messages
			exit 0;
		}
		if ( $line =~ /Dear Subscriber/ ) {
			$mode = 2;
			next;
		}
		if ( $line =~ /^\s*$/ ) {
			next;
		} else {
			$mode = 2;
			# no next - continue to process this line in mode 2
		}
	}

	if ( $mode == 2 ) {
		if ( $line =~ /Please read the instructions below/ ) {
			$mode = 3;
			next; # do not include this line
		}
		if ( $line =~ /^Sent:\s*(.*)/ ) {
			$oes_sent_str = $1;
		}
		if ( $line =~ /^Area:\s*(.*)/ ) {
			$oes_area_str = lc($1);
		}
		if ( $line =~ /^\s*$/ and scalar @warning_text == 0 ) {
			# skip blank lines before beginning of text
			next;
		}
		push @warning_text, $line;
	}

	# ignore mode 3 - processing done at that point
}

# abort if statewide alert appears not to be of local interest
if (( $oes_area_str eq "statewide" ) and &distance_violation( @warning_text ))
{
	exit 0;
}

#
# find matching entry on EDIS' Atom feed
# since the e-mails are incomplete
# They don't include the URL of the full Common Alerting Protocol (CAP) record.
# We have to scan current events in the Atom feed for one posted at the same
# time.  (There's room for improvement here!)  Then we grab the CAP record
# from the URL listed there.
#

my $atom = XML::Atom::Client->new;
my $cap_ns =  XML::Atom::Namespace->new(cap => 'urn:oasis:names:tc:emergency:cap:1.1' );
my $feed = $atom->getFeed($edis_atom_uri);
my @entries = $feed->entries;
my ( $cap, $xml_raw, $xml_url );
foreach my $entry ( @entries ) {
	if ( $oes_sent_str eq $entry->updated ) {
		# get the URL and fetch the CAP record
		my @links = $entry->link;
		foreach my $link ( @links ) {
			if ( $link->rel eq "alternate" ) {
				$xml_url = $link->href;
				( $cap, $xml_raw ) = fetch_cap ( $xml_url );
			}
		}
	}
}

#
# generate alert for mail list
#

# clean up resources
$IO->close;
$body->purge;

#
# generate the message and feed it to the mailer
#

# generate report text
my @text_report;
foreach my $info ( @{$cap->{info}}) {
	push @text_report, info2text( $info );
}
push @text_report, "See $xml_url\n"
	."Status: ".$cap->{status}."\n"
	."Message Type: ".$cap->{msgType}."\n";
debug "text array has ".(scalar @text_report)." entries";

# instantiate the MIME message object with the message headers
my $msg = MIME::Lite->new (
	Subject	=>	 "$subject",
	To	=>	 "$to_addr",
	From	=>	 "$to_addr",
	Date	=>	 "$date",
	Type	=>	'TEXT',
	Data	=>	\@text_report
);

# add CAP XML attachment
$xml_raw =~ s*xml-stylesheet href="capstateoes_simple.xsl"*xml-stylesheet href="http://edis.oes.ca.gov/capstateoes_simple.xsl"*;
debug "XML attachment is ".(length $xml_raw)." characters";
$msg->attach(   Type => 'text/xhtml',
		Filename => "edis-cap-".$cap->{identifier}.".xhtml",
		Data => $xml_raw,
		Disposition => 'attachment ');

# send mail
if ( ! open EXIM_PIPE, "|$exim_cmd $to_addr" ) {
	die "$0: failed to open mailman pipe: $!\n";
}
$msg->print( \*EXIM_PIPE );
if ( !close EXIM_PIPE ) {
	die "$0: failed to close mailman pipe: $!\n";
}
debug "message sent";
exit ( 0 );