summaryrefslogtreecommitdiff
path: root/localmarkdown2sms
blob: 0fa7e785bcc640031474fb82b92d500d00e676ed (plain)
  1. #!/usr/bin/perl
  2. #
  3. # /usr/local/sbin/localmarkdown2sms
  4. # Copyright 2009-2010, Jonas Smedegaard <dr@jones.dk>
  5. #
  6. # Send series of messages through Kannel from simplified Markdown files
  7. # * Lines starting with "#" are "keywords" activating a message series
  8. # * write only a single word
  9. # * use each keyword only once across the whole system
  10. # * use only minuscles (not majuscles, i.e. CAPITAL LETTERS)
  11. # * Lines starting with "##" express pauses
  12. # * a pause is a number + a single letter, without spaces between
  13. # * a pause line can contain multiple pauses, separated by space
  14. # Suggestion for writing style:
  15. #
  16. # * Write explicitly how to activate next series
  17. # * pick keywords tied to nex series rather than the previous
  18. # * use same instruction jargon across all series in the system
  19. use strict;
  20. use warnings;
  21. use Env qw[$debug $info $warn $dummy $nosleep $urldecode];
  22. use Log::Log4perl qw(:easy);
  23. use File::Spec;
  24. use File::Slurp;
  25. use Time::Duration::Parse;
  26. use Text::Unidecode;
  27. use Encode 2.12 qw(encode decode_utf8 _utf8_off); # need v2.12 to support coderef
  28. use LWP::UserAgent;
  29. use URI::Escape;
  30. use Proc::Daemon;
  31. # TODO: Use Coro instead
  32. Proc::Daemon::Init unless ($debug);
  33. my $sms_url = $ENV{SMS_URL} || "http://localhost:13013/cgi-bin/sendsms";
  34. my $sms_usertag = $ENV{SMS_USERTAG} || "username";
  35. my $sms_user = $ENV{SMS_USER} || "tester";
  36. my $sms_pw = $ENV{SMS_PW} || "foobar";
  37. my $sms_api = $ENV{SMS_API};
  38. my $sms_phone = $ENV{SMS_PHONE};
  39. my $sms_smsc = $ENV{SMS_SMSC};
  40. my $sms_msgtag = $ENV{SMS_MSGTAG} || "text";
  41. my $sms_cp = $ENV{SMS_CP} || "utf8";
  42. my $sms_concat = $ENV{SMS_CONCAT};
  43. my $sms_dlr_mask = $ENV{SMS_DLR_MASK};
  44. my $sms_dlr_url = $ENV{SMS_DLR_URL};
  45. my $sms_validity = $ENV{SMS_VALIDITY};
  46. my $sms_req_feat = $ENV{SMS_REQ_FEAT};
  47. my $sms_binfo = $ENV{SMS_BINFO};
  48. my $stripprefix = $ENV{stripprefix};
  49. my $path = $ENV{mdpath};
  50. my (%file, %delay, %reply);
  51. # decode data if passed from kannel
  52. if ($urldecode) {
  53. @ARGV = uri_unescape(@ARGV);
  54. }
  55. my ($phone) = shift @ARGV;
  56. my ($key) = lc (shift @ARGV);
  57. # strip international prefix
  58. # (prefix is optional some places and illegal at other places - forgot where)
  59. $phone =~ s/^\+//g if ($stripprefix);
  60. $sms_phone =~ s/^\+//g if ($stripprefix);
  61. # strip non-word chars from keyword (and use only first chunk of word chars)
  62. $key =~ s/.*?(\w+).*?/$1/;
  63. if ($debug) {
  64. Log::Log4perl->easy_init($DEBUG);
  65. } elsif ($INFO) {
  66. Log::Log4perl->easy_init($INFO);
  67. } elsif ($WARN) {
  68. Log::Log4perl->easy_init($WARN);
  69. } elsif ($ERROR) {
  70. Log::Log4perl->easy_init($ERROR);
  71. }
  72. unless ($path and -d $path) {
  73. ERROR "environment variable \"mdpath\" missing or wrong.";
  74. exit 1;
  75. }
  76. foreach my $file (read_dir( $path )) {
  77. my ($key, $i, $skipkeysection, $skipcontent);
  78. # suppress repeated warnings for same issue
  79. my ($warn_nonkey_delay, $warn_nonkey_content);
  80. next unless ($file =~ /\.mdwn$/);
  81. foreach my $line (read_file( File::Spec->catfile($path, $file))) {
  82. chomp $line;
  83. my $content;
  84. # headline
  85. if ($line =~ /^(#+)\s*(.*?)\s*$/) {
  86. # tidy latest reply
  87. if (defined($key) and defined($reply{$key}[$i])) {
  88. $reply{$key}[$i] = &tidymsg($reply{$key}[$i]);
  89. ($reply{$key}[$i]) || delete $reply{$key}[$i];
  90. }
  91. my $level = length($1);
  92. $content = $2;
  93. # key
  94. if ($level == 1 and $content =~ /(\w+)/) {
  95. $key = lc($1);
  96. $i = 0;
  97. $skipkeysection = undef;
  98. $skipcontent = undef;
  99. if (lc($content) ne $key) {
  100. WARN "key \"$key\" extracted from fuzzy string \"$content\" in file \"$file\"";
  101. }
  102. if (!defined( $delay{$key})) {
  103. $delay{$key}[0] = 0;
  104. $warn_nonkey_delay = undef;
  105. $warn_nonkey_content = undef;
  106. } else {
  107. WARN "skipping non-unique key \"$key\" in file \"$file\"";
  108. $key = undef;
  109. $skipkeysection = 1;
  110. $skipcontent = 1;
  111. }
  112. # delay
  113. } elsif ($level == 2 and $content =~ /((\d+[sm]\s?)+)/) {
  114. $skipcontent = undef;
  115. if (defined( $key)) {
  116. my $delay = parse_duration($1);
  117. if (defined($reply{$key}[$i])) {
  118. $i++;
  119. $delay{$key}[$i] = $delay{$key}[$i - 1];
  120. }
  121. # $delay{$key}[$i] += $delay; # accumulate: forked replies
  122. $delay{$key}[$i] = $delay; # simple: queued replies
  123. if ($content ne $1) {
  124. WARN "delay (${delay}s) resolved from fuzzy string \"$content\" in file \"$file\"";
  125. }
  126. } elsif ($skipkeysection or $warn_nonkey_delay) {
  127. # skipping - already warned about it...
  128. } else {
  129. WARN "ignoring non-key'ed delay line \"$1\" in file \"$file\"";
  130. $warn_nonkey_delay = 1;
  131. $skipcontent = 1;
  132. }
  133. } else {
  134. WARN "ignoring non-parsable headline \"$line\" in file \"$file\"";
  135. $skipcontent = 1;
  136. }
  137. # reply
  138. } else {
  139. $content = $line . "\n";
  140. # ikiwiki directives - strip from content and parse for tags
  141. $content =~ s/(?<!\\)\[\[([^\[\]]*)(?<!\\)\]\]//gs and do {
  142. my $directive_string = $1;
  143. my ($directive, $directive_content);
  144. $directive_string =~ /^\s*\!(tag|taglink)\s*((\s*?\b\w+)+)/ and $file{$file}{'directive'}{'tag'} = [ split /\s+/, $2 ];
  145. };
  146. if ( defined( $key ) and not ($skipcontent)) {
  147. $reply{$key}[$i] .= $content;
  148. } elsif ($skipkeysection or $skipcontent or $warn_nonkey_content) {
  149. # skipping - already warned about it...
  150. } else {
  151. $content =~ /\S/s && WARN "skipping non-key'ed content \"$line\" in file \"$file\"";
  152. $warn_nonkey_content = 1;
  153. }
  154. }
  155. }
  156. # tidy latest reply
  157. if (defined($key) and defined($reply{$key}[$i])) {
  158. $reply{$key}[$i] = &tidymsg($reply{$key}[$i]);
  159. ($reply{$key}[$i]) || delete $reply{$key}[$i];
  160. }
  161. }
  162. sub tidymsg {
  163. my $msg = shift @_;
  164. $msg =~ s/^\h*$//g; # clean virtually empty lines
  165. $msg =~ s/(\S)\h$/$1/g; # strip single trailing space
  166. $msg =~ s/\n\n+/\n\n/g; # strip excess newlines
  167. $msg =~ s/(\S)\n([^\n])/$1 $2/g; # convert newline to space
  168. $msg =~ s/\h*$//g; # strip all trailing spaces
  169. $msg =~ s/^\s*(\w*?.*?)\s*$/$1/s; # strip surrounding space
  170. $msg =~ s/’/'/g; #'simplify non-GSM chars
  171. $msg =~ s/…/.../g; # simplify ellipsis
  172. $msg =~ s/\.\.+/.../g; # multiple dots → psudo-ellipsis
  173. return $msg;
  174. }
  175. # based on Text::Unidecode bug#8017: http://rt.cpan.org/Ticket/Display.html?id=8017#txn-322351
  176. sub transliterate {
  177. my ($tocharset, $string) = @_;
  178. my $res = encode($tocharset, decode_utf8($string), sub {
  179. my $ascii = unidecode(chr $_[0]);
  180. _utf8_off($ascii);
  181. $ascii;
  182. });
  183. return $res;
  184. }
  185. sub sendmsg {
  186. my ($phone, $desc, $msg) = @_;
  187. unless ($dummy) {
  188. my $ua = LWP::UserAgent->new(agent => "localmarkdown2sms");
  189. $ua->timeout(10);
  190. my $url = $sms_url
  191. . '?' . $sms_usertag . '=' . uri_escape($sms_user)
  192. . '&password=' . uri_escape($sms_pw)
  193. . '&to=' . uri_escape($phone);
  194. $url .= '&api_id=' . uri_escape($sms_api) if ($sms_api);
  195. $url .= '&from=' . uri_escape($sms_phone) if ($sms_phone);
  196. $url .= '&smsc=' . uri_escape($sms_smsc) if ($sms_smsc);
  197. $url .= '&concat=' . uri_escape($sms_concat) if ($sms_concat);
  198. $url .= '&dlr-mask=' . uri_escape($sms_dlr_mask) if ($sms_dlr_mask);
  199. $url .= '&dlr-url=' . uri_escape($sms_dlr_url) if ($sms_dlr_url);
  200. $url .= '&validity=' . uri_escape($sms_validity) if ($sms_validity);
  201. $url .= '&req_feat=' . uri_escape($sms_req_feat) if ($sms_req_feat);
  202. $url .= '&binfo=' . uri_escape($sms_binfo) if ($sms_binfo);
  203. # $url .= '&' . $sms_msgtag . '=' . uri_escape(transliterate($sms_cp, $msg));
  204. $url .= '&' . $sms_msgtag . '=' . uri_escape($sms_cp, $msg);
  205. DEBUG "Sending request: $url";
  206. my $response = $ua->request(HTTP::Request->new('GET', $url));
  207. unless ($response->is_success) {
  208. ERROR $response->status_line;
  209. }
  210. DEBUG "Done $desc";
  211. } else {
  212. print STDERR "\n --> $phone: $desc\n";
  213. print STDERR $msg . "\n";
  214. }
  215. }
  216. my $num_children = $#{ $reply{$key} } + 1; # How many children we'll create
  217. if (0 == $num_children) {
  218. &sendmsg($phone, "fallback message", "Sorry, the sms code \"$key\" is unknown.\nPlease send only sms codes to this number.");
  219. exit;
  220. }
  221. if ($debug) {
  222. DEBUG "queueing $num_children replies:";
  223. for my $num ( 0 .. $num_children - 1 ) {
  224. DEBUG " [" . $delay{$key}[$num] . "s]";
  225. }
  226. # DEBUG "\n";
  227. }
  228. for my $num ( 0 .. $num_children - 1 ) {
  229. sleep($delay{$key}[$num]) unless ($nosleep);
  230. &sendmsg($phone, "reply #$num [" . $delay{$key}[$num] . "s]", $reply{$key}[$num]);
  231. }
  232. 1;