diff options
73 files changed, 11833 insertions, 0 deletions
diff --git a/brweather b/brweather new file mode 120000 index 0000000..f0d5be9 --- /dev/null +++ b/brweather @@ -0,0 +1 @@ +../brweather/brweather/brweather
\ No newline at end of file diff --git a/chroot-chromium-browser b/chroot-chromium-browser new file mode 100755 index 0000000..6a20341 --- /dev/null +++ b/chroot-chromium-browser @@ -0,0 +1,21 @@ +#!/bin/bash +# +# Chroot wrapper +# + +# Syntax +if [ -z "$1" ]; then + chroot="squeeze" +else + chroot="$1" +fi + +# Load configuration +if [ -e "$HOME/.config/scripts/chroot" ]; then + source $HOME/.config/scripts/chroot +fi + +xhost local:$CHROOT_USER +sudo su $CHROOT_USER -c "schroot -d /home/$CHROOT_USER -c $chroot -p chromium-browser" & +sleep 1 +xhost - diff --git a/chroot-iceweasel b/chroot-iceweasel new file mode 100755 index 0000000..f2298e7 --- /dev/null +++ b/chroot-iceweasel @@ -0,0 +1,20 @@ +#!/bin/bash +# +# Chroot wrapper +# + +if [ -z "$1" ]; then + chroot="squeeze" +else + chroot="$1" +fi + +# Load configuration +if [ -e "$HOME/.config/scripts/chroot" ]; then + source $HOME/.config/scripts/chroot +fi + +xhost local:$CHROOT_USER +sudo su $CHROOT_USER -c "schroot -d /home/$CHROOT_USER -c $chroot -p iceweasel" & +sleep 1 +xhost - diff --git a/chroot-upgrade b/chroot-upgrade new file mode 100755 index 0000000..562df39 --- /dev/null +++ b/chroot-upgrade @@ -0,0 +1,24 @@ +#!/bin/bash +# +# Chroot mass upgrader. +# + +BASE="/var/chroot/" + +if [ "`whoami`" != 'root' ]; then + sudo="sudo" +fi + +for chroot in `ls $BASE`; do + folder="$BASE/$chroot" + if [ -f "$folder/etc/debian_version" ]; then + echo "Upgrading $folder..." + $sudo mount none -t proc $folder/proc + $sudo mount -o bind /dev $folder/dev + $sudo cp /etc/resolv.conf $folder/etc + $sudo chroot $folder apt-get update + $sudo chroot $folder apt-get dist-upgrade -y + $sudo umount $folder/proc + $sudo umount $folder/dev + fi +done @@ -0,0 +1,77 @@ +#!/bin/bash +# +# Commit both on git and svn. +# + +# Check if a folder is inside a git repository +function is_git { + # simple git folder checker + # usage: is_git <folder> + if [ -z "$1" ]; then + false + elif [ ! -d "$1" ]; then + false + elif [ -d "$1/.git" ]; then + true + else + ( cd "$1" && git status &> /dev/null ) + + if [ "$?" != "128" ]; then + true + else + false + fi + fi +} + +# Check if a folder is inside a svn repository +function is_svn { + # simple svn folder checker + # usage: is_svn <folder> + + if [ -d "$1/.svn" ]; then + return + else + return 1 + fi +} + +# Push to repositories +function git_push { + if [ "`git remote | wc -l`" == "0" ]; then + return + elif git remote | grep -q 'all'; then + git push all --all + elif git remote | grep -q 'origin'; then + git push --all + fi +} + +# Check user information +function git_user { + if ! grep -q "^\[user\]" .git/config; then + echo "No user configuration section found in the repository." + echo "This might be a privacy issue" + + if [ -e "$HOME/.gitconfig" ]; then + echo "You should try to use your default setting:" + echo "cat <<EOF >> .git/config" + grep -A 2 "^\[user\]" $HOME/.gitconfig + echo "EOF" + fi + + exit 1 + fi +} + +if [ ! -z "$1" ]; then + if is_svn .; then + svn commit -m "$*" + fi + + if is_git .; then + git_user + git commit -a -m "$*" + git_push + fi +fi @@ -0,0 +1,76 @@ +#!/usr/bin/gawk -f +# +# csv2sc ver. 0.1 (2001/12/4) +# Copyright (C) 2001 SIGEHUZI Tomoo (tomoo@s.email.ne.jp) + +function is_date(s) { + if (split(s, date, "/") != 3) return 0; + if (date[1] !~ /(19|20)?[0-9][0-9]/) return 0; + if (date[2] !~ /(0?[1-9]|1[012])/) return 0; + if (date[2] !~ /(0?[1-9]|[12][0-9]|3[01])/) return 0; + return 1; +} + +function i_index(n, i, s) { + s = ""; + for (s = ""; ; n = (n - i) / nix - 1) { + i = n % nix; + s = sprintf("%s%s", ix[i], s); + if (n < 1) break; + } + return s; +} + +BEGIN { + nix = split("BCDEFGHIJKLMNOPQRSTUVWXYZ", ix, "") + 1; + ix[0] = "A"; +} + +{ + s = sprintf("%s%s", s, $0); + np += gsub(/"/, "\a"); + if (np % 2) { + s = sprintf("%s\n", s); + next; + } + m = n = split(s, a, ","); + + np = 0; + s = ""; + for (i = j = 1; i <= n; i++) { + s = sprintf("%s%s", s, a[i]); + np += gsub(/"/, "\a", a[i]); + if (np % 2) { + s = sprintf("%s,", s); + continue; + } + np = 0; + a[j++] = s; + s = ""; + } + n = j - 1; + for (i = 1; i <= n; i++) { + s = a[i]; + sub(/^"/, "", s); + sub(/"$/, "", s); + gsub(/\\/, "\\\\", s); + gsub(/""/, "\\\"", s); + gsub(/\n/, "\\n", s); + gsub(/\t/, "\\t", s); + a[i] = s; + } + + for (i = 1; i <= n; i++) { + s = a[i]; + I = i_index(i - 1); + if (s ~ /^[0-9.]+$/) printf("let %s%d = %s\n", I, J, s); + else if (is_date(s)) + printf("let %s%d = @dts(%d,%d,%d)\nfmt %s%d \"\004%%Y/%%m/%%d\"\n", + I, J, date[1], date[2], date[3], I, J); + else printf("leftstring %s%d = \"%s\"\n", I, J, s); + } + + J++; + np = 0; + s = ""; +} diff --git a/gpg-agent-eval b/gpg-agent-eval new file mode 100755 index 0000000..6fa169a --- /dev/null +++ b/gpg-agent-eval @@ -0,0 +1,19 @@ +#!/bin/bash +# +# Initialize the gpg-agent. +# + +# GPG Agent +GPG_TTY=`tty` +export GPG_TTY + +function gpg_agent_eval_run { + if test -f $HOME/.gpg-agent-info && \ + kill -0 `cut -d: -f 2 $HOME/.gpg-agent-info` 2>/dev/null; then + GPG_AGENT_INFO=`cat $HOME/.gpg-agent-info` export GPG_AGENT_INFO + else + eval `gpg-agent --daemon` echo $GPG_AGENT_INFO >$HOME/.gpg-agent-info + fi +} + +gpg_agent_eval_run @@ -0,0 +1,14 @@ +#!/bin/bash +# +# record an audio cd based on current folder wav files +# + +echo CD_DA > toc + +for file in *.wav; do + echo >> toc + echo TRACK AUDIO >> toc + echo FILE \"$file\" 0 >> toc +done + +cdrdao write --speed 8x --device /dev/cdrom1 toc diff --git a/ical2rem b/ical2rem new file mode 100755 index 0000000..aab07d5 --- /dev/null +++ b/ical2rem @@ -0,0 +1,279 @@ +#!/usr/bin/perl -w +# +# ical2rem.pl - +# Reads iCal files and outputs remind-compatible files. Tested ONLY with +# calendar files created by Mozilla Calendar/Sunbird. Use at your own risk. +# Copyright (c) 2005, 2007, Justin B. Alcorn + +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License +# as published by the Free Software Foundation; either version 2 +# of the License, or (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. +# +# +# version 0.5.2 2007-03-23 +# - BUG: leadtime for recurring events had a max of 4 instead of DEFAULT_LEAD_TIME +# - remove project-lead-time, since Category was a non-standard attribute +# - NOTE: There is a bug in iCal::Parser v1.14 that causes multiple calendars to +# fail if a calendar with recurring events is followed by a calendar with no +# recurring events. This has been reported to the iCal::Parser author. +# version 0.5.1 2007-03-21 +# - BUG: Handle multiple calendars on STDIN +# - add --heading option for priority on section headers +# version 0.5 2007-03-21 +# - Add more help options +# - --project-lead-time option +# - Supress printing of heading if there are no todos to print +# version 0.4 +# - Version 0.4 changes all written or inspired by, and thanks to Mark Stosberg +# - Change to GetOptions +# - Change to pipe +# - Add --label, --help options +# - Add Help Text +# - Change to subroutines +# - Efficiency and Cleanup +# version 0.3 +# - Convert to GPL (Thanks to Mark Stosberg) +# - Add usage +# version 0.2 +# - add command line switches +# - add debug code +# - add SCHED _sfun keyword +# - fix typos +# version 0.1 - ALPHA CODE. + +=head1 SYNOPSIS + + cat /path/to/file*.ics | ical2rem.pl > ~/.ical2rem + + All options have reasonable defaults: + --label Calendar name (Default: Calendar) + --lead-time Advance days to start reminders (Default: 3) + --todos, --no-todos Process Todos? (Default: Yes) + --heading Define a priority for static entries + --help Usage + --man Complete man page + +Expects an ICAL stream on STDIN. Converts it to the format +used by the C<remind> script and prints it to STDOUT. + +=head2 --label + + ical2rem.pl --label "Bob's Calendar" + +The syntax generated includes a label for the calendar parsed. +By default this is "Calendar". You can customize this with +the "--label" option. + +=head2 --lead-time + + ical2rem.pl --lead-time 3 + +How may days in advance to start getting reminders about the events. Defaults to 3. + +=head2 --no-todos + + ical2rem.pl --no-todos + +If you don't care about the ToDos the calendar, this will surpress +printing of the ToDo heading, as well as skipping ToDo processing. + +=head2 --heading + + ical2rem.pl --heading "PRIORITY 9999" + +Set an option on static messages output. Using priorities can made the static messages look different from +the calendar entries. See the file defs.rem from the remind distribution for more information. + +=cut + +use strict; +use iCal::Parser; +use DateTime; +use Getopt::Long 2.24 qw':config auto_help'; +use Pod::Usage; +use Data::Dumper; +use vars '$VERSION'; +$VERSION = "0.5.2"; + +# Declare how many days in advance to remind +my $DEFAULT_LEAD_TIME = 3; +my $PROCESS_TODOS = 1; +my $HEADING = ""; +my $help; +my $man; + +my $label = 'Calendar'; +GetOptions ( + "label=s" => \$label, + "lead-time=i" => \$DEFAULT_LEAD_TIME, + "todos!" => \$PROCESS_TODOS, + "heading=s" => \$HEADING, + "help|?" => \$help, + "man" => \$man +); +pod2usage(1) if $help; +pod2usage(-verbose => 2) if $man; + +my $month = ['None','Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec']; + +my @calendars; +my $in; + +while (<>) { + $in .= $_; + if (/END:VCALENDAR/) { + push(@calendars,$in); + $in = ""; + } +} +my $parser = iCal::Parser->new(); +my $hash = $parser->parse_strings(@calendars); + +############################################################## +# +# Subroutines +# +############################################################# +# +# _process_todos() +# expects 'todos' hashref from iCal::Parser is input +# returns String to output +sub _process_todos { + my $todos = shift; + + my ($todo, @newtodos, $leadtime); + my $output = ""; + + $output .= 'REM '.$HEADING.' MSG '.$label.' ToDos:%"%"%'."\n"; + +# For sorting, make sure everything's got something +# To sort on. + my $now = DateTime->now; + for $todo (@{$todos}) { + # remove completed items + if ($todo->{'STATUS'} && $todo->{'STATUS'} eq 'COMPLETED') { + next; + } elsif ($todo->{'DUE'}) { + # All we need is a due date, everything else is sugar + $todo->{'SORT'} = $todo->{'DUE'}->clone; + } elsif ($todo->{'DTSTART'}) { + # for sorting, sort on start date if there's no due date + $todo->{'SORT'} = $todo->{'DTSTART'}->clone; + } else { + # if there's no due or start date, just make it now. + $todo->{'SORT'} = $now; + } + push(@newtodos,$todo); + } + if (! (scalar @newtodos)) { + return ""; + } +# Now sort on the new Due dates and print them out. + for $todo (sort { DateTime->compare($a->{'SORT'}, $b->{'SORT'}) } @newtodos) { + my $due = $todo->{'SORT'}->clone(); + my $priority = ""; + if (defined($todo->{'PRIORITY'})) { + if ($todo->{'PRIORITY'} == 1) { + $priority = "PRIORITY 1000"; + } elsif ($todo->{'PRIORITY'} == 3) { + $priority = "PRIORITY 7500"; + } + } + if (defined($todo->{'DTSTART'}) && defined($todo->{'DUE'})) { + # Lead time is duration of task + lead time + my $diff = ($todo->{'DUE'}->delta_days($todo->{'DTSTART'})->days())+$DEFAULT_LEAD_TIME; + $leadtime = "+".$diff; + } else { + $leadtime = "+".$DEFAULT_LEAD_TIME; + } + $output .= "REM ".$due->month_abbr." ".$due->day." ".$due->year." $leadtime $priority MSG \%a $todo->{'SUMMARY'}\%\"\%\"\%\n"; + } + $output .= 'REM '.$HEADING.' MSG %"%"%'."\n"; + return $output; +} + + +####################################################################### +# +# Main Program +# +###################################################################### + +print _process_todos($hash->{'todos'}) if $PROCESS_TODOS; + +my ($leadtime, $yearkey, $monkey, $daykey,$uid,%eventsbyuid); +print 'REM '.$HEADING.' MSG '.$label.' Events:%"%"%'."\n"; +my $events = $hash->{'events'}; +foreach $yearkey (sort keys %{$events} ) { + my $yearevents = $events->{$yearkey}; + foreach $monkey (sort {$a <=> $b} keys %{$yearevents}){ + my $monevents = $yearevents->{$monkey}; + foreach $daykey (sort {$a <=> $b} keys %{$monevents} ) { + my $dayevents = $monevents->{$daykey}; + foreach $uid (sort { + DateTime->compare($dayevents->{$a}->{'DTSTART'}, $dayevents->{$b}->{'DTSTART'}) + } keys %{$dayevents}) { + my $event = $dayevents->{$uid}; + if ($eventsbyuid{$uid}) { + my $curreventday = $event->{'DTSTART'}->clone; + $curreventday->truncate( to => 'day' ); + $eventsbyuid{$uid}{$curreventday->epoch()} =1; + for (my $i = 0;$i < $DEFAULT_LEAD_TIME && !defined($event->{'LEADTIME'});$i++) { + if ($eventsbyuid{$uid}{$curreventday->subtract( days => $i+1 )->epoch() }) { + $event->{'LEADTIME'} = $i; + } + } + } else { + $eventsbyuid{$uid} = $event; + my $curreventday = $event->{'DTSTART'}->clone; + $curreventday->truncate( to => 'day' ); + $eventsbyuid{$uid}{$curreventday->epoch()} =1; + } + + } + } + } +} +foreach $yearkey (sort keys %{$events} ) { + my $yearevents = $events->{$yearkey}; + foreach $monkey (sort {$a <=> $b} keys %{$yearevents}){ + my $monevents = $yearevents->{$monkey}; + foreach $daykey (sort {$a <=> $b} keys %{$monevents} ) { + my $dayevents = $monevents->{$daykey}; + foreach $uid (sort { + DateTime->compare($dayevents->{$a}->{'DTSTART'}, $dayevents->{$b}->{'DTSTART'}) + } keys %{$dayevents}) { + my $event = $dayevents->{$uid}; + if (exists($event->{'LEADTIME'})) { + $leadtime = "+".$event->{'LEADTIME'}; + } else { + $leadtime = "+".$DEFAULT_LEAD_TIME; + } + my $start = $event->{'DTSTART'}; + print "REM ".$start->month_abbr." ".$start->day." ".$start->year." $leadtime "; + if ($start->hour > 0) { + print " AT "; + print $start->strftime("%H:%M"); + print " SCHED _sfun MSG %a %2 "; + } else { + print " MSG %a "; + } + print "%\"$event->{'SUMMARY'}"; + print " at $event->{'LOCATION'}" if $event->{'LOCATION'}; + print "\%\"%\n"; + } + } + } +} +exit 0; +#:vim set ft=perl ts=4 sts=4 expandtab : diff --git a/image2ascii b/image2ascii new file mode 100755 index 0000000..729cb4d --- /dev/null +++ b/image2ascii @@ -0,0 +1,76 @@ +#! /bin/sh +# +# $ Id: image2ascii,v 1.6 2002/12/01 12:36:56 roland Exp roland $ +# +# Convert any image to an ASCII-graphic using ImageMagick +# +########################################################################## +# +# Copyright (C) 1997-2002 Roland Rosenfeld <roland@spinnaker.de> +# +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License as +# published by the Free Software Foundation; either version 2 of +# the License, or (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +# +########################################################################## + +CONVERT=convert # The ImageMagick convert binary +PBMTOASCII=pbmtoascii # The NetPBM pbmtoascii binary + +umask 077 + +tmpdir=${TMPDIR-/tmp}/image2ascii.$$ +mkdir $tmpdir || exit 1 +trap "rm -rf $tmpdir; exit" 0 1 2 3 15 + +TMPFILE=$tmpdir/image + +usage="Usage: $0 [option] [imagefile] + + -help display this help text + -geometry 132x50 define the size of the ascii image" + + +# set default geometry to display width: +geometry=`stty size </dev/tty | awk '{print $2 "x" $1}'` + +# test if stty did not output a useful value: +case "$geometry" in + 0x0 ) geometry=80x24 ;; + "" ) geometry=80x24 ;; +esac + +case $# in + 0 ) cat > $TMPFILE ;; + 1 ) case "$1" in + -* ) echo "$usage"; exit 0 ;; + * ) cat "$1" > $TMPFILE ;; + esac ;; + 2 ) case "$1" in + -geometry ) geometry=$2 + cat > $TMPFILE ;; + * ) echo "$usage"; exit 0 ;; + esac ;; + 3 ) case "$1" in + -geometry ) geometry=$2 + cat $3 > $TMPFILE ;; + * ) echo "$usage"; exit 0 ;; + esac ;; + * ) echo "$usage"; exit 0 ;; +esac + +# multiply x with 2 and y with 4 (pbmtoascii divides by 2x4) +geometry=`echo $geometry | awk -Fx '{print 2*$1 "x" 4*$2}'` + +$CONVERT -geometry $geometry $TMPFILE $TMPFILE.pbm +$PBMTOASCII -2x4 < $TMPFILE.pbm @@ -0,0 +1,262 @@ +#!/bin/bash + +# little script to generate image galleries for use with original. +# uses imagemagick's convert +# (c) 2005 boris de laage <bdelaage@free.fr> +# based on imgconv by Jakub Steiner +# +# The 'help' section sucks, as my english does. + + +#default options +dir=./web-gallery +zip=0 +rotate=0 +mq=0 +hq=0 +interactive=0 +verbose=echo + +#info.txt stuff +gal_auth="" +gal_name="" +gal_desc="" +gal_date="" +gal_user="" +gal_pass="" + +# convert options +convertor=`which convert` +jhead=`which jhead` +extra_ops="-strip" + +# This script +name=`basename $0` + +# getopt stuff +shortopts="a:hHin:d:D:Mqo:Zr" +longopts="author:quiet,help,interactive,name:,date:,description:,\ +mq,hq,output:,archive,rotate" + + + +function echo_help { +cat <<EOF +Usage : $1 [OPTIONS]... [FILE]... +Convert FILEs + + -o, --output DIR make gallery in DIR + -M, --mq include 1024x768 images (MQ) + -H, --hq include original images (HQ) + -Z, --archive make archives + -i, --interactive edit gallery informations interactively + -a, --author NAME set author's name + -n, --name NAME set gallery's name + -d, --date DATE set date to DATE + -D, --description DESC description + -r, --rotate automatically rotate image based on EXIF + -q, --quiet don't say anything + -h, --help display this help and exit + +FILEs must be JPG, JPEG or PNG. if DIR is not given, the +gallery will be created in $dir. + +EOF + +} + +good_file() { + local ftype + + ftype=`file -b "$1" | cut -d " " -f 1` + + if [ "$ftype" == "JPG" ] || [ "$ftype" == "JPEG" ] || [ "$ftype" == "PNG" ] + then + return 0 + else + return 1 + fi + +} + + +# If we don't have ImageMagick, cry & exit +if [ -z $convertor ]; then + echo "convert not found... Please install ImageMagick." + exit 1 +fi + + +# Parse options +TEMP=`getopt -o $shortopts --long $longopts -n $name -- "$@"` +[ $? != 0 ] && exit 1 + +eval set -- "$TEMP" +while true; do + case "$1" in + -h|--help) + echo_help $name ; exit 0 ;; + + -i|--interactive) + interactive=1 ; shift ;; + + -n|--name) + gal_name=$2 ; shift 2 ;; + + -d|--date) + gal_date=$2 ; shift 2 ;; + + -D|--description) + gal_desc=$2 ; shift 2 ;; + + -a|--author) + gal_auth=$2 ; shift 2 ;; + + -o|--output) + dir=$2 ; shift 2 ;; + + -Z|--zip) + zip=1 ; shift ;; + + -r|--rotate) + rotate=1 ; shift ;; + + -q|--quiet) + verbose=false ; shift ;; + + -M|--mq) + mq=1 ; shift ;; + + -H|--hq) + hq=1 ; shift ;; + + --) + shift ; break ;; + + *) + echo "OOops.. getopt error !" ; echo $@ ; exit 1 ;; + esac +done + + + +# If we don't have JHead and we want to auto-rotate images, cry & exit +if [ $rotate -gt 0 ] && [ -z $jhead ]; then + echo "jhead not found... Please install JHead." + exit 1 +fi + + + +# If no input files are given, display usage & exit +if [ $# == 0 ]; then + cat <<EOF +Usage: $name [-hMHZ] [-o directory] file... + $name -o Gallery *.jpg +Try \`$name --help' for more information. +EOF + exit 1 +fi + +# make dirs +mkdir -p $dir/thumbs +mkdir -p $dir/lq +mkdir -p $dir/comments +chmod o+w $dir/comments +[ $mq -gt 0 ] && mkdir -p $dir/mq +[ $hq -gt 0 ] && mkdir -p $dir/hq +[ $zip -gt 0 ] && mkdir -p $dir/zip + +# Protect info.txt, even if we don't make it. +echo "<Files info.txt>" > $dir/.htaccess +echo " deny from all" >> $dir/.htaccess +echo "</Files>" >> $dir/.htaccess + + +$verbose "Generating O.R.I.G.I.N.A.L gallery in $dir" + +files=$(echo $@ | sed 's/ /\n/g' | sort) + +#files=$@ + +i=1 +for imagefile in $files; do + + good_file "$imagefile" + if [ $? != 0 ]; then + $verbose "$imagefile is not a JPG, JPEG or PNG file, skipped" + continue + fi + + $verbose -n "converting $imagefile " + + $verbose -n "." + $convertor -geometry 120x120 -modulate 100,140,100 -unsharp 1x20 \ + -quality 60 $extra_opts "$imagefile" $dir/thumbs/img-$i.jpg + + $verbose -n "." + $convertor -geometry 640x480 -modulate 100,130,100 -unsharp 1x5 \ + -quality 90 "$imagefile" $dir/lq/img-$i.jpg + + if [ $mq -gt 0 ]; then + $verbose -n "." + $convertor -geometry 1024x768 -modulate 100,130,100 -unsharp 1x5 \ + -quality 80 "$imagefile" $dir/mq/img-$i.jpg + fi + + if [ $hq -gt 0 ] ; then + $verbose -n "." + cp "$imagefile" $dir/hq/img-$i.jpg + fi + + # template for comment + echo "<span>Photo $i</span>
" > $dir/comments/$i.txt + + + i=`expr $i + 1` + $verbose " done" +done + +# auto-rotate stuff +if [ $rotate -gt 0 ]; then + $verbose "rotating" + jhead -autorot $dir/thumbs/*.jpg + jhead -autorot $dir/lq/*.jpg + [ $mq ] && jhead -autorot $dir/mq/*.jpg + [ $hq ] && jhead -autorot $dir/hq/*.jpg +fi + +# zip stuff +if [ $zip -gt 0 ]; then + $verbose "archiving" + [ $mq ] && zip -R $dir/zip/mq.zip $dir/mq/*.jpg + [ $hq ] && zip -R $dir/zip/hq.zip $dir/hq/*.jpg +fi + +#info.txt +protect=n +if [ $interactive == 1 ]; then + echo -n "Gallery name [$gal_name]: " + read gal_name + echo -n "Description: " + read gal_desc + echo -n "Author [$gal_auth]: " + read gal_auth + echo -n "Date [$gal_date]: " + read gal_date + echo -n "Resctrict access ? [y/N]: " + read protect + if [ "$protect" == "y" ] || [ "$protect" == "Y" ]; then + echo -n "restricted user [$gal_user]: " + read gal_user + echo -n "restricted password [$gal_pass]: " + read gal_pass + fi +fi + +[ "$gal_name" != "" ] && echo "name|$gal_name" >> $dir/info.txt +[ "$gal_auth" != "" ] && echo "author|$gal_auth" >> $dir/info.txt +[ "$gal_date" != "" ] && echo "date|$gal_date" >> $dir/info.txt +[ "$gal_desc" != "" ] && echo "description|$gal_desc" >> $dir/info.txt +[ "$gal_user" != "" ] && echo "restricted_user|$gal_user" >> $dir/info.txt +[ "$gal_pass" != "" ] && echo "restricted_password|$gal_pass" >> $dir/info.txt @@ -0,0 +1,38 @@ +#!/bin/bash +# +# worklog wrapper +# + +BASE="$HOME/grupos" +GROUP="$1" +ACTION="$2" +BASENAME="`basename $0`" + +if [ -z "$GROUP" ]; then + echo "Usage: $BASENAME <group> [edit]" + exit 1 +fi + +if [ -z "$EDITOR" ]; then + EDITOR="vi" +fi + +mkdir -p $BASE/$GROUP/worklog + +if [ ! -e "$BASE/$GROUP/worklog/projects" ]; then + cat > $BASE/$GROUP/worklog/projects <<EOF +# Worklog project file +# note that projects appear in Worklog in REVERSE order + +#S:Sample project +#O:Other project +EOF + + echo "First run, you should edit your project list..." + $EDITOR $BASE/$GROUP/worklog/projects + ( cd $BASE/$GROUP/worklog && worklog ) +elif [ "$ACTION" == "edit" ]; then + $EDITOR $BASE/$GROUP/worklog/projects +else + ( cd $BASE/$GROUP/worklog && worklog ) +fi diff --git a/misc/annex-fsck b/misc/annex-fsck new file mode 100755 index 0000000..2ef8066 --- /dev/null +++ b/misc/annex-fsck @@ -0,0 +1,9 @@ +#!/bin/bash + +cd /var/cache/media + +for file in *; do + if [ -d "$file/.git" ]; then + ( echo "Checking $file..." && cd $file && git annex fsck --fast | grep -v " ok" | tee -a /tmp/annex-fsck.log ) + fi +done diff --git a/misc/convert-gitosis-conf b/misc/convert-gitosis-conf new file mode 100755 index 0000000..9b92f68 --- /dev/null +++ b/misc/convert-gitosis-conf @@ -0,0 +1,127 @@ +#!/usr/bin/perl -w +# +# migrate gitosis.conf to gitolite.conf format +# +# Based on gl-conf-convert by: Sitaram Chamarty +# Rewritten by: Behan Webster <behanw@websterwood.com> +# + +use strict; +use warnings; + +if (not @ARGV and -t or @ARGV and $ARGV[0] eq '-h') { + print "Usage:\n gl-conf-convert < gitosis.conf > gitolite.conf\n(please see the documentation for details)\n"; + exit 1; +} + +my @comments = (); +my $groupname; +my %groups; +my $reponame; +my %repos; + +while (<>) +{ + # not supported + if (/^repositories *=/ or /^map /) { + print STDERR "not supported: $_"; + s/^/NOT SUPPORTED: /; + print; + next; + } + + # normalise whitespace to help later regexes + chomp; + s/\s+/ /g; + s/ ?= ?/ = /; + s/^ //; + s/ $//; + + if (/^\s*$/ and @comments > 1) { + @{$repos{$reponame}{comments}} = @comments if $reponame; + @{$groups{$groupname}{comments}} = @comments if $groupname; + @comments = (); + } elsif (/^\s*#/) { + push @comments, $_; + } elsif (/^\[repo\s+(.*?)\]$/) { + $groupname = ''; + $reponame = $1; + $reponame =~ s/\.git$//; + } elsif (/^\[gitosis\]$/) { + $groupname = ''; + $reponame = '@all'; + } elsif (/^gitweb\s*=\s*yes/i) { + push @{$repos{$reponame}{R}}, 'gitweb'; + } elsif (/^daemon\s*=\s*yes/i) { + push @{$repos{$reponame}{R}}, 'daemon'; + } elsif (/^description\s*=\s*(.+?)$/) { + $repos{$reponame}{desc} = $1; + } elsif (/^owner\s*=\s*(.+?)$/) { + $repos{$reponame}{owner} = $1; + } elsif (/^\[group\s+(.*)\]$/) { + $reponame = ''; + $groupname = $1; + } elsif (/^members\s*=\s*(.*)/) { + push @{$groups{$groupname}{users}}, map {s/\@([^.]+)$/_$1/g; $_} split(' ', $1); + } elsif (/^write?able\s*=\s*(.*)/) { + foreach my $repo (split(' ', $1)) { + $repo =~ s/\.git$//; + push @{$repos{$repo}{RW}}, "\@$groupname"; + } + } elsif (/^readonly\s*=\s*(.*)/) { + foreach my $repo (split(' ', $1)) { + $repo =~ s/\.git$//; + push @{$repos{$repo}{R}}, "\@$groupname"; + } + } +} + +#use Data::Dumper; +#print Dumper(\%repos); +#print Dumper(\%groups); + +# Groups +print "#\n# Groups\n#\n\n"; +foreach my $grp (sort keys %groups) { + next unless @{$groups{$grp}{users}}; + printf join("\n", @{$groups{$grp}{comments}})."\n" if $groups{$grp}{comments}; + printf "\@%-19s = %s\n", $grp, join(' ', @{$groups{$grp}{users}}); +} + +# Gitweb +print "\n#\n# Gitweb\n#\n\n"; +foreach my $repo (sort keys %repos) { + if ($repos{$repo}{desc}) { + @{$repos{$repo}{R}} = grep(!/^gitweb$/, @{$repos{$repo}{R}}); + print $repo; + print " \"$repos{$repo}{owner}\"" if $repos{$repo}{owner}; + print " = \"$repos{$repo}{desc}\"\n"; + } +} + +# Repos +print "\n#\n# Repos\n#\n"; +foreach my $repo (sort keys %repos) { + print "\n"; + printf join("\n", @{$repos{$repo}{comments}})."\n" if $repos{$repo}{comments}; + #if ($repos{$repo}{desc}) { + # @{$repos{$repo}{R}} = grep(!/^gitweb$/, @{$repos{$repo}{R}}); + #} + print "repo\t$repo\n"; + foreach my $access (qw(RW+ RW R)) { + next unless $repos{$repo}{$access}; + my @keys; + foreach my $key (@{$repos{$repo}{$access}}) { + if ($key =~ /^\@(.*)/) { + next unless defined $groups{$1} and @{$groups{$1}{users}}; + } + push @keys, $key; + } + printf "\t$access\t= %s\n", join(' ', @keys) if @keys; + } + #if ($repos{$repo}{desc}) { + # print $repo; + # print " \"$repos{$repo}{owner}\"" if $repos{$repo}{owner}; + # print " = \"$repos{$repo}{desc}\"\n"; + #} +} diff --git a/misc/dupbackup b/misc/dupbackup new file mode 100755 index 0000000..f020c36 --- /dev/null +++ b/misc/dupbackup @@ -0,0 +1,51 @@ +#!/bin/bash +# +# dupbackup: duplicity wrapper +# feedback: rhatto at riseup.net +# +# dupbackup is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or any later version. +# +# common.sh is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along with +# this program; if not, write to the Free Software Foundation, Inc., 59 Temple +# Place - Suite 330, Boston, MA 02111-1307, USA + +# Usage: dupbackup <host> [option] + +USER="`whoami`" +LOCAL_FOLDER="/mnt/crypt/home/$USER/" +REMOVE_OLDER_THAN="3M" +KEY="" +HOST="$1" +OPTION="$2" + +# Load configuration +if [ -e "$HOME/.config/scripts/dupbackup" ]; then + source $HOME/.config/scripts/dupbackup +fi + +if [ ! -z "$HOST" ]; then + DEST="/var/backups/remote/$USER/duplicity" + DEST="scp://$USER@$HOST/$DEST" +else + DEST="file:///var/backups/users/$USER/duplicity" +fi + +if [ -z "$OPTION" ]; then + OPTION="incr" +fi + +mkdir -p $LOCAL_FOLDER/tmp/duplicity + +duplicity $OPTION -v6 --full-if-older-than $REMOVE_OLDER_THAN \ + --allow-source-mismatch --encrypt-key $KEY \ + --sign-key $KEY $LOCAL_FOLDER $DEST \ + --tempdir $LOCAL_FOLDER/tmp/duplicity \ + --exclude $LOCAL_FOLDER/tmp/duplicity + +duplicity remove-older-than $REMOVE_OLDER_THAN $DEST --force diff --git a/misc/email/checkmail.sh b/misc/email/checkmail.sh new file mode 100755 index 0000000..3a21c9a --- /dev/null +++ b/misc/email/checkmail.sh @@ -0,0 +1,9 @@ +#!/bin/bash +# inspirado em http://www.vivaolinux.com.br/dicas/verDica.php?codigo=2432 +# + +FETCH=`fetchmail -c` +TOTAL=`echo $FETCH | awk '{ print $1 }'` +SEEN=`echo $FETCH | awk '{ print $3 }' | sed -e 's/(//'` +NEW=`echo "$TOTAL - $SEEN" | bc` +echo $NEW/$TOTAL diff --git a/misc/email/eml2mbox/eml2mbox.rb b/misc/email/eml2mbox/eml2mbox.rb new file mode 100755 index 0000000..1fc7bca --- /dev/null +++ b/misc/email/eml2mbox/eml2mbox.rb @@ -0,0 +1,265 @@ +#!/usr/bin/ruby +#============================================================================================# +# eml2mbox.rb v0.08 # +# Last updated: Jan 23, 2004 # +# # +# Converts a bunch of eml files into one mbox file. # +# # +# Usage: [ruby] eml2mbx.rb [-c] [-l] [-s] [-yz] [emlpath [trgtmbx]] # +# Switches: # +# -c Remove CRs (^M) appearing at end of lines (Unix) # +# -l Remove LFs appearing at beggining of lines (old Mac) - not tested # +# -s Don't use standard mbox postmark formatting (for From_ line) # +# This will force the use of original From and Date found in mail headers. # +# Not recommended, unless you really have problems importing emls. # +# -yz Use this to force the order of the year and timezone in date in the From_ # +# line from the default [timezone][year] to [year][timezone]. # +# emlpath - Path of dir with eml files. Defaults to the current dir if not specified # +# trgtmbx - Name of the target mbox file. Defaults to "archive.mbox" in 'emlpath' # +# # +# Ruby homepage: http://www.ruby-lang.org/en/ # +# Unix mailbox format: http://www.broobles.com/eml2mbox/mbox.html # +# This script : http://www.broobles.com/eml2mbox # +# # +#============================================================================================# +# Licence: # +# # +# This script is free software; you can redistribute it and/or modify it under the terms of # +# the GNU Lesser General Public License as published by the Free Software Foundation; # +# either version 2.1 of the License, or (at your option) any later version. # +# # +# You should have received a copy of the GNU Lesser General Public License along with this # +# script; if not, please visit http://www.gnu.org/copyleft/gpl.html for more information. # +#============================================================================================# + +require "parsedate" + +include ParseDate + +#=======================================================# +# Class that encapsulates the processing file in memory # +#=======================================================# + +class FileInMemory + + ZoneOffset = { + # Standard zones by RFC 2822 + 'UTC' => '0000', + 'UT' => '0000', 'GMT' => '0000', + 'EST' => '-0500', 'EDT' => '-0400', + 'CST' => '-0600', 'CDT' => '-0500', + 'MST' => '-0700', 'MDT' => '-0600', + 'PST' => '-0800', 'PDT' => '-0700', + } + + def initialize() + @lines = Array.new + @counter = 1 # keep the 0 position for the From_ line + @from = nil # from part of the From_ line + @date = nil # date part of the From_ line + end + + def addLine(line) + # If the line is a 'false' From line, add a '>' to its beggining + line = line.sub(/From/, '>From') if line =~ /^From/ and @from!=nil + + # If the line is the first valid From line, save it (without the line break) + if line =~ /^From:\s.*@/ and @from==nil + @from = line.sub(/From:/,'From') + @from = @from.chop # Remove line break(s) + @from = standardizeFrom(@from) unless $switches["noStandardFromLine"] + end + + # Get the date + if $switches["noStandardFromLine"] + # Don't parse the content of the Date header + @date = line.sub(/Date:\s/,'') if line =~ /^Date:\s/ and @date==nil + else + if line =~ /^Date:\s/ and @date==nil + # Parse content of the Date header and convert to the mbox standard for the From_ line + @date = line.sub(/Date:\s/,'') + year, month, day, hour, minute, second, timezone, wday = parsedate(@date) + # Need to convert the timezone from a string to a 4 digit offset + unless timezone =~ /[+|-]\d*/ + timezone=ZoneOffset[timezone] + end + time = Time.gm(year,month,day,hour,minute,second) + @date = formMboxDate(time,timezone) + end + end + + # Now add the line to the array + line = fixLineEndings(line) + @lines[@counter]=line + @counter+=1 + end + + # Forms the first line (from + date) and returns all the lines + # Returns all the lines in the file + def getProcessedLines() + if @from != nil + # Add from and date to the first line + if @date==nil + puts "WARN: Failed to extract date. Will use current time in the From_ line" + @date=formMboxDate(Time.now,nil) + end + @lines[0] = @from + " " + @date + + @lines[0] = fixLineEndings(@lines[0]) + @lines[@counter] = "" + return @lines + end + # else don't return anything + end + + # Fixes CR/LFs + def fixLineEndings(line) + line = removeCR(line) if $switches["removeCRs"]; + line = removeLF(line) if $switches["removeLFs"]; + return line + end + + # emls usually have CR+LF (DOS) line endings, Unix uses LF as a line break, + # so there's a hanging CR at the end of the line when viewed on Unix. + # This method will remove the next to the last character from a line + def removeCR(line) + line = line[0..-3]+line[-1..-1] if line[-2]==0xD + return line + end + + # Similar to the above. This one is for Macs that use CR as a line break. + # So, remove the last char + def removeLF(line) + line = line[0..-2] if line[-1]==0xA + return line + end + +end + +#================# +# Helper methods # +#================# + +# Converts: 'From "some one <aa@aa.aa>" <aa@aa.aa>' -> 'From aa@aa.aa' +def standardizeFrom(fromLine) + # Get indexes of last "<" and ">" in line + openIndex = fromLine.rindex('<') + closeIndex = fromLine.rindex('>') + if openIndex!=nil and closeIndex!=nil + fromLine = fromLine[0..4]+fromLine[openIndex+1..closeIndex-1] + end + # else leave as it is - it is either already well formed or is invalid + return fromLine +end + +# Returns a mbox postmark formatted date. +# If timezone is unknown, it is skipped. +# mbox date format used is described here: +# http://www.broobles.com/eml2mbox/mbox.html +def formMboxDate(time,timezone) + if timezone==nil + return time.strftime("%a %b %d %H:%M:%S %Y") + else + if $switches["zoneYearOrder"] + return time.strftime("%a %b %d %H:%M:%S "+timezone.to_s+" %Y") + else + return time.strftime("%a %b %d %H:%M:%S %Y "+timezone.to_s) + end + end +end + + +# Extracts all switches from the command line and returns +# a hashmap with valid switch names as keys and booleans as values +# Moves real params to the beggining of the ARGV array +def extractSwitches() + switches = Hash.new(false) # All switches (values) default to false + i=0 + while (ARGV[i]=~ /^-/) # while arguments are switches + if ARGV[i]=="-c" + switches["removeCRs"] = true + puts "\nWill fix lines ending with a CR" + elsif ARGV[i]=="-l" + switches["removeLFs"] = true + puts "\nWill fix lines beggining with a LF" + elsif ARGV[i]=="-s" + switches["noStandardFromLine"] = true + puts "\nWill use From and Date from mail headers in From_ line" + elsif ARGV[i]=="-yz" + switches["zoneYearOrder"] = true + puts "\nTimezone will be placed before the year in From_ line" + else + puts "\nUnknown switch: "+ARGV[i]+". Ignoring." + end + i = i+1 + end + # Move real arguments to the beggining of the array + ARGV[0] = ARGV[i] + ARGV[1] = ARGV[i+1] + return switches +end + +#===============# +# Main # +#===============# + + $switches = extractSwitches() + + # Extract specified directory with emls and the target archive (if any) + emlDir = "." # default if not specified + emlDir = ARGV[0] if ARGV[0]!=nil + mboxArchive = emlDir+"/archive.mbox" # default if not specified + mboxArchive = ARGV[1] if ARGV[1] != nil + + # Show specified settings + puts "\nSpecified dir : "+emlDir + puts "Specified file: "+mboxArchive+"\n" + + # Check that the dir exists + if FileTest.directory?(emlDir) + Dir.chdir(emlDir) + else + puts "\n["+emlDir+"] is not a directory (might not exist). Please specify a valid dir" + exit(0) + end + + # Check if destination file exists. If yes allow user to select an option. + canceled = false + if FileTest.exist?(mboxArchive) + print "\nFile ["+mboxArchive+"] exists! Please select: [A]ppend [O]verwrite [C]ancel (default) " + sel = STDIN.gets.chomp + if sel == 'A' or sel == 'a' + aFile = File.new(mboxArchive, "a"); + elsif sel == 'O' or sel == 'o' + aFile = File.new(mboxArchive, "w"); + else + canceled = true + end + else + # File doesn't exist, open for writing + aFile = File.new(mboxArchive, "w"); + end + + if not canceled + puts + files = Dir["*.eml"] + if files.size == 0 + puts "No *.eml files in this directory. mbox file not created." + aFile.close + File.delete(mboxArchive) + exit(0) + end + # For each .eml file in the specified directory do the following + files.each() do |x| + puts "Processing file: "+x + thisFile = FileInMemory.new() + File.open(x).each {|item| thisFile.addLine(item) } + lines = thisFile.getProcessedLines + if lines == nil + puts "WARN: File ["+x+"] doesn't seem to have a regular From: line. Not included in mbox" + else + lines.each {|line| aFile.puts line} + end + end + aFile.close + end diff --git a/misc/email/eml2mbox/licence.txt b/misc/email/eml2mbox/licence.txt new file mode 100644 index 0000000..3b20440 --- /dev/null +++ b/misc/email/eml2mbox/licence.txt @@ -0,0 +1,458 @@ + GNU LESSER GENERAL PUBLIC LICENSE + Version 2.1, February 1999 + + Copyright (C) 1991, 1999 Free Software Foundation, Inc. + 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + +[This is the first released version of the Lesser GPL. It also counts + as the successor of the GNU Library Public License, version 2, hence + the version number 2.1.] + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +Licenses are intended to guarantee your freedom to share and change +free software--to make sure the software is free for all its users. + + This license, the Lesser General Public License, applies to some +specially designated software packages--typically libraries--of the +Free Software Foundation and other authors who decide to use it. You +can use it too, but we suggest you first think carefully about whether +this license or the ordinary General Public License is the better +strategy to use in any particular case, based on the explanations below. + + When we speak of free software, we are referring to freedom of use, +not price. Our General Public Licenses are designed to make sure that +you have the freedom to distribute copies of free software (and charge +for this service if you wish); that you receive source code or can get +it if you want it; that you can change the software and use pieces of +it in new free programs; and that you are informed that you can do +these things. + + To protect your rights, we need to make restrictions that forbid +distributors to deny you these rights or to ask you to surrender these +rights. These restrictions translate to certain responsibilities for +you if you distribute copies of the library or if you modify it. + + For example, if you distribute copies of the library, whether gratis +or for a fee, you must give the recipients all the rights that we gave +you. You must make sure that they, too, receive or can get the source +code. If you link other code with the library, you must provide +complete object files to the recipients, so that they can relink them +with the library after making changes to the library and recompiling +it. And you must show them these terms so they know their rights. + + We protect your rights with a two-step method: (1) we copyright the +library, and (2) we offer you this license, which gives you legal +permission to copy, distribute and/or modify the library. + + To protect each distributor, we want to make it very clear that +there is no warranty for the free library. Also, if the library is +modified by someone else and passed on, the recipients should know +that what they have is not the original version, so that the original +author's reputation will not be affected by problems that might be +introduced by others. + + Finally, software patents pose a constant threat to the existence of +any free program. We wish to make sure that a company cannot +effectively restrict the users of a free program by obtaining a +restrictive license from a patent holder. Therefore, we insist that +any patent license obtained for a version of the library must be +consistent with the full freedom of use specified in this license. + + Most GNU software, including some libraries, is covered by the +ordinary GNU General Public License. This license, the GNU Lesser +General Public License, applies to certain designated libraries, and +is quite different from the ordinary General Public License. We use +this license for certain libraries in order to permit linking those +libraries into non-free programs. + + When a program is linked with a library, whether statically or using +a shared library, the combination of the two is legally speaking a +combined work, a derivative of the original library. The ordinary +General Public License therefore permits such linking only if the +entire combination fits its criteria of freedom. The Lesser General +Public License permits more lax criteria for linking other code with +the library. + + We call this license the "Lesser" General Public License because it +does Less to protect the user's freedom than the ordinary General +Public License. It also provides other free software developers Less +of an advantage over competing non-free programs. These disadvantages +are the reason we use the ordinary General Public License for many +libraries. However, the Lesser license provides advantages in certain +special circumstances. + + For example, on rare occasions, there may be a special need to +encourage the widest possible use of a certain library, so that it becomes +a de-facto standard. To achieve this, non-free programs must be +allowed to use the library. A more frequent case is that a free +library does the same job as widely used non-free libraries. In this +case, there is little to gain by limiting the free library to free +software only, so we use the Lesser General Public License. + + In other cases, permission to use a particular library in non-free +programs enables a greater number of people to use a large body of +free software. For example, permission to use the GNU C Library in +non-free programs enables many more people to use the whole GNU +operating system, as well as its variant, the GNU/Linux operating +system. + + Although the Lesser General Public License is Less protective of the +users' freedom, it does ensure that the user of a program that is +linked with the Library has the freedom and the wherewithal to run +that program using a modified version of the Library. + + The precise terms and conditions for copying, distribution and +modification follow. Pay close attention to the difference between a +"work based on the library" and a "work that uses the library". The +former contains code derived from the library, whereas the latter must +be combined with the library in order to run. + + GNU LESSER GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any software library or other +program which contains a notice placed by the copyright holder or +other authorized party saying it may be distributed under the terms of +this Lesser General Public License (also called "this License"). +Each licensee is addressed as "you". + + A "library" means a collection of software functions and/or data +prepared so as to be conveniently linked with application programs +(which use some of those functions and data) to form executables. + + The "Library", below, refers to any such software library or work +which has been distributed under these terms. A "work based on the +Library" means either the Library or any derivative work under +copyright law: that is to say, a work containing the Library or a +portion of it, either verbatim or with modifications and/or translated +straightforwardly into another language. (Hereinafter, translation is +included without limitation in the term "modification".) + + "Source code" for a work means the preferred form of the work for +making modifications to it. For a library, complete source code means +all the source code for all modules it contains, plus any associated +interface definition files, plus the scripts used to control compilation +and installation of the library. + + Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running a program using the Library is not restricted, and output from +such a program is covered only if its contents constitute a work based +on the Library (independent of the use of the Library in a tool for +writing it). Whether that is true depends on what the Library does +and what the program that uses the Library does. + + 1. You may copy and distribute verbatim copies of the Library's +complete source code as you receive it, in any medium, provided that +you conspicuously and appropriately publish on each copy an +appropriate copyright notice and disclaimer of warranty; keep intact +all the notices that refer to this License and to the absence of any +warranty; and distribute a copy of this License along with the +Library. + + You may charge a fee for the physical act of transferring a copy, +and you may at your option offer warranty protection in exchange for a +fee. + + 2. You may modify your copy or copies of the Library or any portion +of it, thus forming a work based on the Library, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) The modified work must itself be a software library. + + b) You must cause the files modified to carry prominent notices + stating that you changed the files and the date of any change. + + c) You must cause the whole of the work to be licensed at no + charge to all third parties under the terms of this License. + + d) If a facility in the modified Library refers to a function or a + table of data to be supplied by an application program that uses + the facility, other than as an argument passed when the facility + is invoked, then you must make a good faith effort to ensure that, + in the event an application does not supply such function or + table, the facility still operates, and performs whatever part of + its purpose remains meaningful. + + (For example, a function in a library to compute square roots has + a purpose that is entirely well-defined independent of the + application. Therefore, Subsection 2d requires that any + application-supplied function or table used by this function must + be optional: if the application does not supply it, the square + root function must still compute square roots.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Library, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Library, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote +it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Library. + +In addition, mere aggregation of another work not based on the Library +with the Library (or with a work based on the Library) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may opt to apply the terms of the ordinary GNU General Public +License instead of this License to a given copy of the Library. To do +this, you must alter all the notices that refer to this License, so +that they refer to the ordinary GNU General Public License, version 2, +instead of to this License. (If a newer version than version 2 of the +ordinary GNU General Public License has appeared, then you can specify +that version instead if you wish.) Do not make any other change in +these notices. + + Once this change is made in a given copy, it is irreversible for +that copy, so the ordinary GNU General Public License applies to all +subsequent copies and derivative works made from that copy. + + This option is useful when you wish to copy part of the code of +the Library into a program that is not a library. + + 4. You may copy and distribute the Library (or a portion or +derivative of it, under Section 2) in object code or executable form +under the terms of Sections 1 and 2 above provided that you accompany +it with the complete corresponding machine-readable source code, which +must be distributed under the terms of Sections 1 and 2 above on a +medium customarily used for software interchange. + + If distribution of object code is made by offering access to copy +from a designated place, then offering equivalent access to copy the +source code from the same place satisfies the requirement to +distribute the source code, even though third parties are not +compelled to copy the source along with the object code. + + 5. A program that contains no derivative of any portion of the +Library, but is designed to work with the Library by being compiled or +linked with it, is called a "work that uses the Library". Such a +work, in isolation, is not a derivative work of the Library, and +therefore falls outside the scope of this License. + + However, linking a "work that uses the Library" with the Library +creates an executable that is a derivative of the Library (because it +contains portions of the Library), rather than a "work that uses the +library". The executable is therefore covered by this License. +Section 6 states terms for distribution of such executables. + + When a "work that uses the Library" uses material from a header file +that is part of the Library, the object code for the work may be a +derivative work of the Library even though the source code is not. +Whether this is true is especially significant if the work can be +linked without the Library, or if the work is itself a library. The +threshold for this to be true is not precisely defined by law. + + If such an object file uses only numerical parameters, data +structure layouts and accessors, and small macros and small inline +functions (ten lines or less in length), then the use of the object +file is unrestricted, regardless of whether it is legally a derivative +work. (Executables containing this object code plus portions of the +Library will still fall under Section 6.) + + Otherwise, if the work is a derivative of the Library, you may +distribute the object code for the work under the terms of Section 6. +Any executables containing that work also fall under Section 6, +whether or not they are linked directly with the Library itself. + + 6. As an exception to the Sections above, you may also combine or +link a "work that uses the Library" with the Library to produce a +work containing portions of the Library, and distribute that work +under terms of your choice, provided that the terms permit +modification of the work for the customer's own use and reverse +engineering for debugging such modifications. + + You must give prominent notice with each copy of the work that the +Library is used in it and that the Library and its use are covered by +this License. You must supply a copy of this License. If the work +during execution displays copyright notices, you must include the +copyright notice for the Library among them, as well as a reference +directing the user to the copy of this License. Also, you must do one +of these things: + + a) Accompany the work with the complete corresponding + machine-readable source code for the Library including whatever + changes were used in the work (which must be distributed under + Sections 1 and 2 above); and, if the work is an executable linked + with the Library, with the complete machine-readable "work that + uses the Library", as object code and/or source code, so that the + user can modify the Library and then relink to produce a modified + executable containing the modified Library. (It is understood + that the user who changes the contents of definitions files in the + Library will not necessarily be able to recompile the application + to use the modified definitions.) + + b) Use a suitable shared library mechanism for linking with the + Library. A suitable mechanism is one that (1) uses at run time a + copy of the library already present on the user's computer system, + rather than copying library functions into the executable, and (2) + will operate properly with a modified version of the library, if + the user installs one, as long as the modified version is + interface-compatible with the version that the work was made with. + + c) Accompany the work with a written offer, valid for at + least three years, to give the same user the materials + specified in Subsection 6a, above, for a charge no more + than the cost of performing this distribution. + + d) If distribution of the work is made by offering access to copy + from a designated place, offer equivalent access to copy the above + specified materials from the same place. + + e) Verify that the user has already received a copy of these + materials or that you have already sent this user a copy. + + For an executable, the required form of the "work that uses the +Library" must include any data and utility programs needed for +reproducing the executable from it. However, as a special exception, +the materials to be distributed need not include anything that is +normally distributed (in either source or binary form) with the major +components (compiler, kernel, and so on) of the operating system on +which the executable runs, unless that component itself accompanies +the executable. + + It may happen that this requirement contradicts the license +restrictions of other proprietary libraries that do not normally +accompany the operating system. Such a contradiction means you cannot +use both them and the Library together in an executable that you +distribute. + + 7. You may place library facilities that are a work based on the +Library side-by-side in a single library together with other library +facilities not covered by this License, and distribute such a combined +library, provided that the separate distribution of the work based on +the Library and of the other library facilities is otherwise +permitted, and provided that you do these two things: + + a) Accompany the combined library with a copy of the same work + based on the Library, uncombined with any other library + facilities. This must be distributed under the terms of the + Sections above. + + b) Give prominent notice with the combined library of the fact + that part of it is a work based on the Library, and explaining + where to find the accompanying uncombined form of the same work. + + 8. You may not copy, modify, sublicense, link with, or distribute +the Library except as expressly provided under this License. Any +attempt otherwise to copy, modify, sublicense, link with, or +distribute the Library is void, and will automatically terminate your +rights under this License. However, parties who have received copies, +or rights, from you under this License will not have their licenses +terminated so long as such parties remain in full compliance. + + 9. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Library or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Library (or any work based on the +Library), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Library or works based on it. + + 10. Each time you redistribute the Library (or any work based on the +Library), the recipient automatically receives a license from the +original licensor to copy, distribute, link with or modify the Library +subject to these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties with +this License. + + 11. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Library at all. For example, if a patent +license would not permit royalty-free redistribution of the Library by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Library. + +If any portion of this section is held invalid or unenforceable under any +particular circumstance, the balance of the section is intended to apply, +and the section as a whole is intended to apply in other circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 12. If the distribution and/or use of the Library is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Library under this License may add +an explicit geographical distribution limitation excluding those countries, +so that distribution is permitted only in or among countries not thus +excluded. In such case, this License incorporates the limitation as if +written in the body of this License. + + 13. The Free Software Foundation may publish revised and/or new +versions of the Lesser General Public License from time to time. +Such new versions will be similar in spirit to the present version, +but may differ in detail to address new problems or concerns. + +Each version is given a distinguishing version number. If the Library +specifies a version number of this License which applies to it and +"any later version", you have the option of following the terms and +conditions either of that version or of any later version published by +the Free Software Foundation. If the Library does not specify a +license version number, you may choose any version ever published by +the Free Software Foundation. + + 14. If you wish to incorporate parts of the Library into other free +programs whose distribution conditions are incompatible with these, +write to the author to ask for permission. For software which is +copyrighted by the Free Software Foundation, write to the Free +Software Foundation; we sometimes make exceptions for this. Our +decision will be guided by the two goals of preserving the free status +of all derivatives of our free software and of promoting the sharing +and reuse of software generally. + + NO WARRANTY + + 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO +WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. +EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR +OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY +KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE +LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME +THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN +WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY +AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU +FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR +CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE +LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING +RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A +FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF +SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH +DAMAGES. + + END OF TERMS AND CONDITIONS diff --git a/misc/email/estripa-emails.c b/misc/email/estripa-emails.c new file mode 100755 index 0000000..66c5473 --- /dev/null +++ b/misc/email/estripa-emails.c @@ -0,0 +1,50 @@ +/* + * Copyleft 2003: + * + * Esse software é distribuído através da licença URUBU: + * você só pode fazer um número de cópias cuja paridade + * seja a mesma do dia do mês que você se encontra; + * modificações são permitidas em qualquer dia da semana; + * + * estripa.c + * rhatto@riseup.net + * + */ + +#include <stdio.h> + +main(int argc, char *argv[]) { + + FILE *fp1, *fp2; + char letra; + short flag = 0; + + if(argc != 3) { fprintf(stderr, "sintaxe: estripa <origem> <destino>\n"); return 0; } + + fp1 = fopen(argv[1], "rb"); + fp2 = fopen(argv[2], "wb"); + + if(fp1 == (FILE *)0 || fp2 == (FILE *)0) { + + fprintf(stderr, "erro ao abrir arquivo\n"); + exit(1); + + } + + while((letra = getc(fp1)) != EOF) { + + if(letra == '<') { flag = 1; } + else if(flag && (letra == '>')) { flag = 0; fprintf(fp2, ", "); } + + if(flag && (letra != '<')) { putc(letra, fp2); } + + } + + fprintf(fp2, "\n"); + + fclose(fp1); + fclose(fp2); + + return 0; + +} diff --git a/misc/email/vcard-filter b/misc/email/vcard-filter new file mode 100644 index 0000000..363aa07 --- /dev/null +++ b/misc/email/vcard-filter @@ -0,0 +1,154 @@ +#!/usr/bin/perl -Tw + +# mutt.vcard.filter - vcard filter for use with the mutt autoview facility +# Copyright (C) 1997,1998,1999 David A Pearson +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the license, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +# This little perl script is a simple filter for text/x-vcard +# attachments. I'm pretty sure I've *not* included everything +# possible in here, but it "works for me". Feel free to improve +# in any way you see fit. +# +# Here is how I use it. In my ~/.mutt_mailcap (use your filename of +# choice) I have the following entry: +# +# text/x-vcard; mutt.vcard.filter; copiousoutput +# +# All you then need to do is add a line like: +# +# auto_view text/x-vcard +# +# to your ~/.muttrc (use your filename of choice). +# +# All comments/flames/feedback can be directed to: +# +# davep@davep.org +# +# http://www.davep.org/mutt/ +# + +use strict; + +my $in_card = 0; +my @address = (); +my @contacts = (); +my @additional = (); +my @notes = (); +my $name = ""; +my $title = ""; +my $org = ""; +my $found_note = 0; +my $len; +my $i; +my $addr_line; +my $contact_line; + +while ( <> ) +{ + if ( $in_card ) + { + if ( /^fn:\s*(.*)$/i ) + { + $name = $1; + } + elsif ( /^n:\s*(.*);\s*(.*)$/i ) + { + @additional = ( "", "Additional information:", "" ) if $#additional == -1; + + @additional = ( @additional, "Last Name:\t$1", "First Name:\t$2" ); + } + elsif ( /^title:\s*(.*)$/i ) + { + $title = $1; + } + elsif ( /^org:\s*(.*)$/i ) + { + $org = $1; + } + elsif ( /^adr:\s*(.*)$/i ) + { + my $addr = $1; + + $addr =~ s/;+/;/g; + + @address = split( /;/, $addr ); + } + elsif ( /^email;\s*(.*?):\s*(.*)$/i || /^tel;\s*(.*?):\s*(.*)$/i ) + { + my $type = $1; + my $value = $2; + + @contacts = ( @contacts, uc( substr( $type, 0, 1 ) ) . + substr( $type, 1 ) . ": $value" ); + } + elsif ( /^note:\s*(.*)$/i ) + { + @notes = ( "" ) if $#notes == -1; + @notes = ( @notes, $1 ); + + $found_note = 1; + } + elsif ( /^=.{2}=$/ && $found_note ) + { + my $line = <>; + + chomp( $line ); + + @notes = ( "" ) if $#notes == -1; + @notes = ( @notes, $line ); + } + elsif ( /^end:\s*vcard$/i ) + { + $in_card = 0; + } + } + else + { + $in_card = /^begin:\s*vcard\s*$/i; + } +} + +@address = ( $org, @address ) if $org; +@address = ( $title, @address ) if $title; +@address = ( $name, @address ) if $name; + +format STDOUT = +@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +$addr_line, $contact_line +. + +$len = $#address > $#contacts ? $#address : $#contacts; + +print "" . ( "=" x 76 ) . "\n"; + +for ( $i = 0; $i <= $len; $i++ ) +{ + $addr_line = $i <= $#address ? $address[ $i ] : ""; + $contact_line = $i <= $#contacts ? $contacts[ $i ] : ""; + write; +} + +for ( $i = 0; $i <= $#notes; $i++ ) +{ + print "$notes[ $i ]\n"; +} + +for ( $i = 0; $i <= $#additional; $i++ ) +{ + print "$additional[ $i ]\n"; +} + +print "" . ( "=" x 76 ) . "\n"; diff --git a/misc/eterm-trans b/misc/eterm-trans new file mode 100755 index 0000000..5003ddb --- /dev/null +++ b/misc/eterm-trans @@ -0,0 +1,6 @@ +#!/bin/bash +# +# eterm-trans: wrapper script for a transparent Eterm +# + +Eterm --trans --font1 monospace --scrollbar 0 -f white --buttonbar 0 --borderless -g 124x55+10+20 -c white -neterm diff --git a/misc/firefox-rotate b/misc/firefox-rotate new file mode 100755 index 0000000..e116e0a --- /dev/null +++ b/misc/firefox-rotate @@ -0,0 +1,21 @@ +#!/bin/bash +# +# firefox profile local backup +# + +BACKUPDIR="$HOME/backups/mozilla" + +if [ ! -d "/$BACKUPDIR" ]; then + mkdir -p $BACKUPDIR +fi + +if [ -d "/$BACKUPDIR/mozilla.2" ]; then + rm -rf /$BACKUPDIR/mozilla.2 +fi + +if [ -d "/$BACKUPDIR/mozilla.1" ]; then + mv /$BACKUPDIR/mozilla.1 /$BACKUPDIR/mozilla.2 +fi + +cp -Rp $HOME/.mozilla /$BACKUPDIR/mozilla.1 + diff --git a/misc/freeshell b/misc/freeshell new file mode 100755 index 0000000..a2f6e38 --- /dev/null +++ b/misc/freeshell @@ -0,0 +1,17 @@ +#!/usr/bin/expect +spawn telnet freeshell.org +# Not absolutely necessary, but good to keep the spawn_id for later +set telnet $spawn_id +# Case insensitive, just in case.. +expect -nocase "login:" +send "user\r" +# My telnetd insisted on an uppercase P. This works bothways +expect -nocase "password:" +send "SENHA\r" +# Match the prompt (contains a $) +expect -re {\$} +# Get the environment variables +send "env\r" +# Wait for the prompt +expect -re {\$} +exit diff --git a/misc/google b/misc/google new file mode 100755 index 0000000..b0e15ea --- /dev/null +++ b/misc/google @@ -0,0 +1,17 @@ +#!/bin/bash + +BROWSER=lynx + +if [ $# -eq 0 ] +then + echo "Usage: chkargs argument..." 1>&2 + exit 1 +fi + +search=$1 +while shift +do + search="$search+$1" +done + +$BROWSER "http://www.google.com/search?q=$search" & diff --git a/misc/mount-tablet b/misc/mount-tablet new file mode 100755 index 0000000..b73c2eb --- /dev/null +++ b/misc/mount-tablet @@ -0,0 +1,21 @@ +#!/bin/bash +# +# mount-tablet +# + +# Parameters +BASENAME="`basename $0`" +MOUNTPOINT="/media/tablet" + +# Set sudo config +if [ "`whoami`" != 'root' ]; then + sudo="sudo" +fi + +if [ "$BASENAME" == "mount-tablet" ]; then + $sudo mkdir -p $MOUNTPOINT + $sudo mtpfs -o allow_other $MOUNTPOINT +elif [ "$BASENAME" == "umount-tablet" ]; then + $sudo umount $MOUNTPOINT +fi + diff --git a/misc/noisecd b/misc/noisecd new file mode 100755 index 0000000..c83bbc1 --- /dev/null +++ b/misc/noisecd @@ -0,0 +1,59 @@ +#!/bin/bash +# +# noisecd: add noise cd to rhatto's +# noise cd txt database +# +# feedback: rhatto@riseup.net | GPL +# +# cansado(a) de nao saber onde estah aquela musica ou arquivo num +# sistema de armazenamento distribuido em dezenas de cds? +# +# aqui estah sua solucao! mantenha uma arvore completa de todos os +# seus arquivos disponiveis em midia removivel no seu proprio +# diretorio pessoal, com um truque muito simples. +# +# etiquete os seus cds de mp3, por exemplo, de noise 1, noise 2, +# noise 3, ..., noise n; em seguida, crie n pastas com os nomes iguais +# ao nome de cada cd; em seguida, monte o cd e entre em sua pasta +# especifica e de um comando do tipo +# +# cp -R -s /cdrom/* . +# +# isso criara recursivamente em sua pasta os links simbolicos que vao +# direto pros arquivos do cd, desde que este seja o cd atualmente montado. +# +# se voce fizer com todos os seus cds de musica, o resultado sera uma +# arvore completa contendo links simbolicos para arquivos dos cds. +# +# com isso voce pode procurar suas musicas mais facilmente atraves do find +# ou do locate, ou entao navegando entre as pastas; uma vez achado o +# arquivo desejado, eh soh montar o respectivo cd e ir pra galera! +# +# este script eh um exemplo de como automatizar a tarefa de criar essa arvore. +# + +NOISE_TREE=/var/data/catalogo/noise +NOISE_DATABASE=$NOISE_TREE/noise-cd.txt +NOISE_DIR=/media/cdrom +NOISE_MODE="complex" + +if [ -z "$1" ]; then + echo "usage: `basename $0` <cd-number>" + exit 1 +fi + +cd $NOISE_DIR +ls -R -A -1 | sed -e "s/^/$1 /" >> $NOISE_DATABASE + +if [ "$NOISE_MODE" != "simple" ]; then + + mkdir "$NOISE_TREE/noise-$1" + cd "$NOISE_TREE/noise-$1" + cp -R -s $NOISE_DIR/* . + + cd "$NOISE_TREE" + rm -f noise-tree.tar.gz; cd .. + tar zcvf noise-tree.tar.gz "$NOISE_TREE/" + mv noise-tree.tar.gz "$NOISE_TREE/" + +fi diff --git a/misc/parse_remind.pl b/misc/parse_remind.pl new file mode 100644 index 0000000..bdd9f23 --- /dev/null +++ b/misc/parse_remind.pl @@ -0,0 +1,41 @@ +#!/usr/bin/perl +# +# This script is designed to have an email piped to it eg. from mutt. +# It will split apart all the text/calendar attachments and enter them into +# the 'remind' calendar. +# + +use strict; +use warnings; + +use MIME::Parser; + +my $CONVERT = '~/.mutt/ical2rem.pl'; +my $REMINDERS = '~/remind/mutt.rem'; + +################################################################################ + +my $parser = new MIME::Parser; +$parser->output_under('/tmp'); +my $entity = $parser->parse(\*STDIN); + +my @parts = $entity->parts(); +my $count = 0; + +foreach my $part (@parts) { + if ($part->head->mime_type eq 'text/calendar') { + my $body = $part->bodyhandle; + my $cmd = $CONVERT.' '.$body->path.' >> '.$REMINDERS; + print STDERR `$cmd`; + last if ($? != 0); + $count++; + } +} + +$parser->filer->purge; +if ($count == 0) { + print STDERR "No calendar entries found."; + exit(1); +} + +exit(0); diff --git a/misc/ps_mem.py b/misc/ps_mem.py new file mode 100755 index 0000000..deae67f --- /dev/null +++ b/misc/ps_mem.py @@ -0,0 +1,240 @@ +#!/usr/bin/env python + +# Try to determine how much RAM is currently being used per program. +# Note per _program_, not per process. So for example this script +# will report RAM used by all httpd process together. In detail it reports: +# sum(private RAM for program processes) + sum(Shared RAM for program processes) +# The shared RAM is problematic to calculate, and this script automatically +# selects the most accurate method available for your kernel. + +# Author: P@draigBrady.com +# Source: http://www.pixelbeat.org/scripts/ps_mem.py + +# V1.0 06 Jul 2005 Initial release +# V1.1 11 Aug 2006 root permission required for accuracy +# V1.2 08 Nov 2006 Add total to output +# Use KiB,MiB,... for units rather than K,M,... +# V1.3 22 Nov 2006 Ignore shared col from /proc/$pid/statm for +# 2.6 kernels up to and including 2.6.9. +# There it represented the total file backed extent +# V1.4 23 Nov 2006 Remove total from output as it's meaningless +# (the shared values overlap with other programs). +# Display the shared column. This extra info is +# useful, especially as it overlaps between programs. +# V1.5 26 Mar 2007 Remove redundant recursion from human() +# V1.6 05 Jun 2007 Also report number of processes with a given name. +# Patch from riccardo.murri@gmail.com +# V1.7 20 Sep 2007 Use PSS from /proc/$pid/smaps if available, which +# fixes some over-estimation and allows totalling. +# Enumerate the PIDs directly rather than using ps, +# which fixes the possible race between reading +# RSS with ps, and shared memory with this program. +# Also we can show non truncated command names. +# V1.8 28 Sep 2007 More accurate matching for stats in /proc/$pid/smaps +# as otherwise could match libraries causing a crash. +# Patch from patrice.bouchand.fedora@gmail.com +# V1.9 20 Feb 2008 Fix invalid values reported when PSS is available. +# Reported by Andrey Borzenkov <arvidjaar@mail.ru> + +# Notes: +# +# All interpreted programs where the interpreter is started +# by the shell or with env, will be merged to the interpreter +# (as that's what's given to exec). For e.g. all python programs +# starting with "#!/usr/bin/env python" will be grouped under python. +# You can change this by changing comm= to args= below but that will +# have the undesirable affect of splitting up programs started with +# differing parameters (for e.g. mingetty tty[1-6]). +# +# For 2.6 kernels up to and including 2.6.13 and later 2.4 redhat kernels +# (rmap vm without smaps) it can not be accurately determined how many pages +# are shared between processes in general or within a program in our case: +# http://lkml.org/lkml/2005/7/6/250 +# A warning is printed if overestimation is possible. +# In addition for 2.6 kernels up to 2.6.9 inclusive, the shared +# value in /proc/$pid/statm is the total file-backed extent of a process. +# We ignore that, introducing more overestimation, again printing a warning. +# Since kernel 2.6.23-rc8-mm1 PSS is available in smaps, which allows +# us to calculate a more accurate value for the total RAM used by programs. +# +# I don't take account of memory allocated for a program +# by other programs. For e.g. memory used in the X server for +# a program could be determined, but is not. + +import sys, os, string + +if os.geteuid() != 0: + sys.stderr.write("Sorry, root permission required.\n"); + sys.exit(1) + +PAGESIZE=os.sysconf("SC_PAGE_SIZE")/1024 #KiB +our_pid=os.getpid() + +#(major,minor,release) +def kernel_ver(): + kv=open("/proc/sys/kernel/osrelease").readline().split(".")[:3] + for char in "-_": + kv[2]=kv[2].split(char)[0] + return (int(kv[0]), int(kv[1]), int(kv[2])) + +kv=kernel_ver() + +have_pss=0 + +#return Private,Shared +#Note shared is always a subset of rss (trs is not always) +def getMemStats(pid): + global have_pss + Private_lines=[] + Shared_lines=[] + Pss_lines=[] + Rss=int(open("/proc/"+str(pid)+"/statm").readline().split()[1])*PAGESIZE + if os.path.exists("/proc/"+str(pid)+"/smaps"): #stat + for line in open("/proc/"+str(pid)+"/smaps").readlines(): #open + if line.startswith("Shared"): + Shared_lines.append(line) + elif line.startswith("Private"): + Private_lines.append(line) + elif line.startswith("Pss"): + have_pss=1 + Pss_lines.append(line) + Shared=sum([int(line.split()[1]) for line in Shared_lines]) + Private=sum([int(line.split()[1]) for line in Private_lines]) + #Note Shared + Private = Rss above + #The Rss in smaps includes video card mem etc. + if have_pss: + pss_adjust=0.5 #add 0.5KiB as this average error due to trunctation + Pss=sum([float(line.split()[1])+pss_adjust for line in Pss_lines]) + Shared = Pss - Private + elif (2,6,1) <= kv <= (2,6,9): + Shared=0 #lots of overestimation, but what can we do? + Private = Rss + else: + Shared=int(open("/proc/"+str(pid)+"/statm").readline().split()[2]) + Shared*=PAGESIZE + Private = Rss - Shared + return (Private, Shared) + +def getCmdName(pid): + cmd = file("/proc/%d/status" % pid).readline()[6:-1] + exe = os.path.basename(os.path.realpath("/proc/%d/exe" % pid)) + if exe.startswith(cmd): + cmd=exe #show non truncated version + #Note because we show the non truncated name + #one can have separated programs as follows: + #584.0 KiB + 1.0 MiB = 1.6 MiB mozilla-thunder (exe -> bash) + # 56.0 MiB + 22.2 MiB = 78.2 MiB mozilla-thunderbird-bin + return cmd + +cmds={} +shareds={} +count={} +for pid in os.listdir("/proc/"): + try: + pid = int(pid) #note Thread IDs not listed in /proc/ which is good + if pid == our_pid: continue + except: + continue + try: + cmd = getCmdName(pid) + except: + #permission denied or + #kernel threads don't have exe links or + #process gone + continue + try: + private, shared = getMemStats(pid) + except: + continue #process gone + if shareds.get(cmd): + if have_pss: #add shared portion of PSS together + shareds[cmd]+=shared + elif shareds[cmd] < shared: #just take largest shared val + shareds[cmd]=shared + else: + shareds[cmd]=shared + cmds[cmd]=cmds.setdefault(cmd,0)+private + if count.has_key(cmd): + count[cmd] += 1 + else: + count[cmd] = 1 + +#Add shared mem for each program +total=0 +for cmd in cmds.keys(): + cmds[cmd]=cmds[cmd]+shareds[cmd] + total+=cmds[cmd] #valid if PSS available + +sort_list = cmds.items() +sort_list.sort(lambda x,y:cmp(x[1],y[1])) +sort_list=filter(lambda x:x[1],sort_list) #get rid of zero sized processes + +#The following matches "du -h" output +#see also human.py +def human(num, power="Ki"): + powers=["Ki","Mi","Gi","Ti"] + while num >= 1000: #4 digits + num /= 1024.0 + power=powers[powers.index(power)+1] + return "%.1f %s" % (num,power) + +def cmd_with_count(cmd, count): + if count>1: + return "%s (%u)" % (cmd, count) + else: + return cmd + +print " Private + Shared = RAM used\tProgram \n" +for cmd in sort_list: + print "%8sB + %8sB = %8sB\t%s" % (human(cmd[1]-shareds[cmd[0]]), + human(shareds[cmd[0]]), human(cmd[1]), + cmd_with_count(cmd[0], count[cmd[0]])) +if have_pss: + print "-" * 33 + print " " * 24 + "%8sB" % human(total) + print "=" * 33 +print "\n Private + Shared = RAM used\tProgram \n" + +#Warn of possible inaccuracies +#2 = accurate & can total +#1 = accurate only considering each process in isolation +#0 = some shared mem not reported +#-1= all shared mem not reported +def shared_val_accuracy(): + """http://wiki.apache.org/spamassassin/TopSharedMemoryBug""" + if kv[:2] == (2,4): + if open("/proc/meminfo").read().find("Inact_") == -1: + return 1 + return 0 + elif kv[:2] == (2,6): + if os.path.exists("/proc/"+str(os.getpid())+"/smaps"): + if open("/proc/"+str(os.getpid())+"/smaps").read().find("Pss:")!=-1: + return 2 + else: + return 1 + if (2,6,1) <= kv <= (2,6,9): + return -1 + return 0 + else: + return 1 + +vm_accuracy = shared_val_accuracy() +if vm_accuracy == -1: + sys.stderr.write( + "Warning: Shared memory is not reported by this system.\n" + ) + sys.stderr.write( + "Values reported will be too large, and totals are not reported\n" + ) +elif vm_accuracy == 0: + sys.stderr.write( + "Warning: Shared memory is not reported accurately by this system.\n" + ) + sys.stderr.write( + "Values reported could be too large, and totals are not reported\n" + ) +elif vm_accuracy == 1: + sys.stderr.write( + "Warning: Shared memory is slightly over-estimated by this system\n" + "for each program, so totals are not reported.\n" + ) diff --git a/misc/repo b/misc/repo new file mode 100755 index 0000000..d6b46c8 --- /dev/null +++ b/misc/repo @@ -0,0 +1,710 @@ +#!/bin/sh + +## repo default configuration +## +REPO_URL='https://gerrit.googlesource.com/git-repo' +REPO_REV='stable' + +# Copyright (C) 2008 Google Inc. +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. + +magic='--calling-python-from-/bin/sh--' +"""exec" python -E "$0" "$@" """#$magic" +if __name__ == '__main__': + import sys + if sys.argv[-1] == '#%s' % magic: + del sys.argv[-1] +del magic + +# increment this whenever we make important changes to this script +VERSION = (1, 17) + +# increment this if the MAINTAINER_KEYS block is modified +KEYRING_VERSION = (1,0) +MAINTAINER_KEYS = """ + + Repo Maintainer <repo@android.kernel.org> +-----BEGIN PGP PUBLIC KEY BLOCK----- +Version: GnuPG v1.4.2.2 (GNU/Linux) + +mQGiBEj3ugERBACrLJh/ZPyVSKeClMuznFIrsQ+hpNnmJGw1a9GXKYKk8qHPhAZf +WKtrBqAVMNRLhL85oSlekRz98u41H5si5zcuv+IXJDF5MJYcB8f22wAy15lUqPWi +VCkk1l8qqLiuW0fo+ZkPY5qOgrvc0HW1SmdH649uNwqCbcKb6CxaTxzhOwCgj3AP +xI1WfzLqdJjsm1Nq98L0cLcD/iNsILCuw44PRds3J75YP0pze7YF/6WFMB6QSFGu +aUX1FsTTztKNXGms8i5b2l1B8JaLRWq/jOnZzyl1zrUJhkc0JgyZW5oNLGyWGhKD +Fxp5YpHuIuMImopWEMFIRQNrvlg+YVK8t3FpdI1RY0LYqha8pPzANhEYgSfoVzOb +fbfbA/4ioOrxy8ifSoga7ITyZMA+XbW8bx33WXutO9N7SPKS/AK2JpasSEVLZcON +ae5hvAEGVXKxVPDjJBmIc2cOe7kOKSi3OxLzBqrjS2rnjiP4o0ekhZIe4+ocwVOg +e0PLlH5avCqihGRhpoqDRsmpzSHzJIxtoeb+GgGEX8KkUsVAhbQpUmVwbyBNYWlu +dGFpbmVyIDxyZXBvQGFuZHJvaWQua2VybmVsLm9yZz6IYAQTEQIAIAUCSPe6AQIb +AwYLCQgHAwIEFQIIAwQWAgMBAh4BAheAAAoJEBZTDV6SD1xl1GEAn0x/OKQpy7qI +6G73NJviU0IUMtftAKCFMUhGb/0bZvQ8Rm3QCUpWHyEIu7kEDQRI97ogEBAA2wI6 +5fs9y/rMwD6dkD/vK9v4C9mOn1IL5JCPYMJBVSci+9ED4ChzYvfq7wOcj9qIvaE0 +GwCt2ar7Q56me5J+byhSb32Rqsw/r3Vo5cZMH80N4cjesGuSXOGyEWTe4HYoxnHv +gF4EKI2LK7xfTUcxMtlyn52sUpkfKsCpUhFvdmbAiJE+jCkQZr1Z8u2KphV79Ou+ +P1N5IXY/XWOlq48Qf4MWCYlJFrB07xjUjLKMPDNDnm58L5byDrP/eHysKexpbakL +xCmYyfT6DV1SWLblpd2hie0sL3YejdtuBMYMS2rI7Yxb8kGuqkz+9l1qhwJtei94 +5MaretDy/d/JH/pRYkRf7L+ke7dpzrP+aJmcz9P1e6gq4NJsWejaALVASBiioqNf +QmtqSVzF1wkR5avZkFHuYvj6V/t1RrOZTXxkSk18KFMJRBZrdHFCWbc5qrVxUB6e +N5pja0NFIUCigLBV1c6I2DwiuboMNh18VtJJh+nwWeez/RueN4ig59gRTtkcc0PR +35tX2DR8+xCCFVW/NcJ4PSePYzCuuLvp1vEDHnj41R52Fz51hgddT4rBsp0nL+5I +socSOIIezw8T9vVzMY4ArCKFAVu2IVyBcahTfBS8q5EM63mONU6UVJEozfGljiMw +xuQ7JwKcw0AUEKTKG7aBgBaTAgT8TOevpvlw91cAAwUP/jRkyVi/0WAb0qlEaq/S +ouWxX1faR+vU3b+Y2/DGjtXQMzG0qpetaTHC/AxxHpgt/dCkWI6ljYDnxgPLwG0a +Oasm94BjZc6vZwf1opFZUKsjOAAxRxNZyjUJKe4UZVuMTk6zo27Nt3LMnc0FO47v +FcOjRyquvgNOS818irVHUf12waDx8gszKxQTTtFxU5/ePB2jZmhP6oXSe4K/LG5T ++WBRPDrHiGPhCzJRzm9BP0lTnGCAj3o9W90STZa65RK7IaYpC8TB35JTBEbrrNCp +w6lzd74LnNEp5eMlKDnXzUAgAH0yzCQeMl7t33QCdYx2hRs2wtTQSjGfAiNmj/WW +Vl5Jn+2jCDnRLenKHwVRFsBX2e0BiRWt/i9Y8fjorLCXVj4z+7yW6DawdLkJorEo +p3v5ILwfC7hVx4jHSnOgZ65L9s8EQdVr1ckN9243yta7rNgwfcqb60ILMFF1BRk/ +0V7wCL+68UwwiQDvyMOQuqkysKLSDCLb7BFcyA7j6KG+5hpsREstFX2wK1yKeraz +5xGrFy8tfAaeBMIQ17gvFSp/suc9DYO0ICK2BISzq+F+ZiAKsjMYOBNdH/h0zobQ +HTHs37+/QLMomGEGKZMWi0dShU2J5mNRQu3Hhxl3hHDVbt5CeJBb26aQcQrFz69W +zE3GNvmJosh6leayjtI9P2A6iEkEGBECAAkFAkj3uiACGwwACgkQFlMNXpIPXGWp +TACbBS+Up3RpfYVfd63c1cDdlru13pQAn3NQy/SN858MkxN+zym86UBgOad2 +=CMiZ +-----END PGP PUBLIC KEY BLOCK----- +""" + +GIT = 'git' # our git command +MIN_GIT_VERSION = (1, 5, 4) # minimum supported git version +repodir = '.repo' # name of repo's private directory +S_repo = 'repo' # special repo reposiory +S_manifests = 'manifests' # special manifest repository +REPO_MAIN = S_repo + '/main.py' # main script + + +import optparse +import os +import re +import readline +import subprocess +import sys +import urllib2 + +home_dot_repo = os.path.expanduser('~/.repoconfig') +gpg_dir = os.path.join(home_dot_repo, 'gnupg') + +extra_args = [] +init_optparse = optparse.OptionParser(usage="repo init -u url [options]") + +# Logging +group = init_optparse.add_option_group('Logging options') +group.add_option('-q', '--quiet', + dest="quiet", action="store_true", default=False, + help="be quiet") + +# Manifest +group = init_optparse.add_option_group('Manifest options') +group.add_option('-u', '--manifest-url', + dest='manifest_url', + help='manifest repository location', metavar='URL') +group.add_option('-b', '--manifest-branch', + dest='manifest_branch', + help='manifest branch or revision', metavar='REVISION') +group.add_option('-m', '--manifest-name', + dest='manifest_name', + help='initial manifest file', metavar='NAME.xml') +group.add_option('--mirror', + dest='mirror', action='store_true', + help='mirror the forrest') +group.add_option('--reference', + dest='reference', + help='location of mirror directory', metavar='DIR') +group.add_option('--depth', type='int', default=None, + dest='depth', + help='create a shallow clone with given depth; see git clone') +group.add_option('-g', '--groups', + dest='groups', default='default', + help='restrict manifest projects to ones with a specified group', + metavar='GROUP') +group.add_option('-p', '--platform', + dest='platform', default="auto", + help='restrict manifest projects to ones with a specified' + 'platform group [auto|all|none|linux|darwin|...]', + metavar='PLATFORM') + + +# Tool +group = init_optparse.add_option_group('repo Version options') +group.add_option('--repo-url', + dest='repo_url', + help='repo repository location', metavar='URL') +group.add_option('--repo-branch', + dest='repo_branch', + help='repo branch or revision', metavar='REVISION') +group.add_option('--no-repo-verify', + dest='no_repo_verify', action='store_true', + help='do not verify repo source code') + +# Other +group = init_optparse.add_option_group('Other options') +group.add_option('--config-name', + dest='config_name', action="store_true", default=False, + help='Always prompt for name/e-mail') + +class CloneFailure(Exception): + """Indicate the remote clone of repo itself failed. + """ + + +def _Init(args): + """Installs repo by cloning it over the network. + """ + opt, args = init_optparse.parse_args(args) + if args: + init_optparse.print_usage() + sys.exit(1) + + url = opt.repo_url + if not url: + url = REPO_URL + extra_args.append('--repo-url=%s' % url) + + branch = opt.repo_branch + if not branch: + branch = REPO_REV + extra_args.append('--repo-branch=%s' % branch) + + if branch.startswith('refs/heads/'): + branch = branch[len('refs/heads/'):] + if branch.startswith('refs/'): + print >>sys.stderr, "fatal: invalid branch name '%s'" % branch + raise CloneFailure() + + if not os.path.isdir(repodir): + try: + os.mkdir(repodir) + except OSError, e: + print >>sys.stderr, \ + 'fatal: cannot make %s directory: %s' % ( + repodir, e.strerror) + # Don't faise CloneFailure; that would delete the + # name. Instead exit immediately. + # + sys.exit(1) + + _CheckGitVersion() + try: + if _NeedSetupGnuPG(): + can_verify = _SetupGnuPG(opt.quiet) + else: + can_verify = True + + dst = os.path.abspath(os.path.join(repodir, S_repo)) + _Clone(url, dst, opt.quiet) + + if can_verify and not opt.no_repo_verify: + rev = _Verify(dst, branch, opt.quiet) + else: + rev = 'refs/remotes/origin/%s^0' % branch + + _Checkout(dst, branch, rev, opt.quiet) + except CloneFailure: + if opt.quiet: + print >>sys.stderr, \ + 'fatal: repo init failed; run without --quiet to see why' + raise + + +def _CheckGitVersion(): + cmd = [GIT, '--version'] + try: + proc = subprocess.Popen(cmd, stdout=subprocess.PIPE) + except OSError, e: + print >>sys.stderr + print >>sys.stderr, "fatal: '%s' is not available" % GIT + print >>sys.stderr, 'fatal: %s' % e + print >>sys.stderr + print >>sys.stderr, 'Please make sure %s is installed'\ + ' and in your path.' % GIT + raise CloneFailure() + + ver_str = proc.stdout.read().strip() + proc.stdout.close() + proc.wait() + + if not ver_str.startswith('git version '): + print >>sys.stderr, 'error: "%s" unsupported' % ver_str + raise CloneFailure() + + ver_str = ver_str[len('git version '):].strip() + ver_act = tuple(map(lambda x: int(x), ver_str.split('.')[0:3])) + if ver_act < MIN_GIT_VERSION: + need = '.'.join(map(lambda x: str(x), MIN_GIT_VERSION)) + print >>sys.stderr, 'fatal: git %s or later required' % need + raise CloneFailure() + + +def _NeedSetupGnuPG(): + if not os.path.isdir(home_dot_repo): + return True + + kv = os.path.join(home_dot_repo, 'keyring-version') + if not os.path.exists(kv): + return True + + kv = open(kv).read() + if not kv: + return True + + kv = tuple(map(lambda x: int(x), kv.split('.'))) + if kv < KEYRING_VERSION: + return True + return False + + +def _SetupGnuPG(quiet): + if not os.path.isdir(home_dot_repo): + try: + os.mkdir(home_dot_repo) + except OSError, e: + print >>sys.stderr, \ + 'fatal: cannot make %s directory: %s' % ( + home_dot_repo, e.strerror) + sys.exit(1) + + if not os.path.isdir(gpg_dir): + try: + os.mkdir(gpg_dir, 0700) + except OSError, e: + print >>sys.stderr, \ + 'fatal: cannot make %s directory: %s' % ( + gpg_dir, e.strerror) + sys.exit(1) + + env = os.environ.copy() + env['GNUPGHOME'] = gpg_dir.encode() + + cmd = ['gpg', '--import'] + try: + proc = subprocess.Popen(cmd, + env = env, + stdin = subprocess.PIPE) + except OSError, e: + if not quiet: + print >>sys.stderr, 'warning: gpg (GnuPG) is not available.' + print >>sys.stderr, 'warning: Installing it is strongly encouraged.' + print >>sys.stderr + return False + + proc.stdin.write(MAINTAINER_KEYS) + proc.stdin.close() + + if proc.wait() != 0: + print >>sys.stderr, 'fatal: registering repo maintainer keys failed' + sys.exit(1) + print + + fd = open(os.path.join(home_dot_repo, 'keyring-version'), 'w') + fd.write('.'.join(map(lambda x: str(x), KEYRING_VERSION)) + '\n') + fd.close() + return True + + +def _SetConfig(local, name, value): + """Set a git configuration option to the specified value. + """ + cmd = [GIT, 'config', name, value] + if subprocess.Popen(cmd, cwd = local).wait() != 0: + raise CloneFailure() + + +def _InitHttp(): + handlers = [] + + mgr = urllib2.HTTPPasswordMgrWithDefaultRealm() + try: + import netrc + n = netrc.netrc() + for host in n.hosts: + p = n.hosts[host] + mgr.add_password(p[1], 'http://%s/' % host, p[0], p[2]) + mgr.add_password(p[1], 'https://%s/' % host, p[0], p[2]) + except: + pass + handlers.append(urllib2.HTTPBasicAuthHandler(mgr)) + handlers.append(urllib2.HTTPDigestAuthHandler(mgr)) + + if 'http_proxy' in os.environ: + url = os.environ['http_proxy'] + handlers.append(urllib2.ProxyHandler({'http': url, 'https': url})) + if 'REPO_CURL_VERBOSE' in os.environ: + handlers.append(urllib2.HTTPHandler(debuglevel=1)) + handlers.append(urllib2.HTTPSHandler(debuglevel=1)) + urllib2.install_opener(urllib2.build_opener(*handlers)) + +def _Fetch(url, local, src, quiet): + if not quiet: + print >>sys.stderr, 'Get %s' % url + + cmd = [GIT, 'fetch'] + if quiet: + cmd.append('--quiet') + err = subprocess.PIPE + else: + err = None + cmd.append(src) + cmd.append('+refs/heads/*:refs/remotes/origin/*') + cmd.append('refs/tags/*:refs/tags/*') + + proc = subprocess.Popen(cmd, cwd = local, stderr = err) + if err: + proc.stderr.read() + proc.stderr.close() + if proc.wait() != 0: + raise CloneFailure() + +def _DownloadBundle(url, local, quiet): + if not url.endswith('/'): + url += '/' + url += 'clone.bundle' + + proc = subprocess.Popen( + [GIT, 'config', '--get-regexp', 'url.*.insteadof'], + cwd = local, + stdout = subprocess.PIPE) + for line in proc.stdout: + m = re.compile(r'^url\.(.*)\.insteadof (.*)$').match(line) + if m: + new_url = m.group(1) + old_url = m.group(2) + if url.startswith(old_url): + url = new_url + url[len(old_url):] + break + proc.stdout.close() + proc.wait() + + if not url.startswith('http:') and not url.startswith('https:'): + return False + + dest = open(os.path.join(local, '.git', 'clone.bundle'), 'w+b') + try: + try: + r = urllib2.urlopen(url) + except urllib2.HTTPError, e: + if e.code == 404: + return False + print >>sys.stderr, 'fatal: Cannot get %s' % url + print >>sys.stderr, 'fatal: HTTP error %s' % e.code + raise CloneFailure() + except urllib2.URLError, e: + print >>sys.stderr, 'fatal: Cannot get %s' % url + print >>sys.stderr, 'fatal: error %s' % e.reason + raise CloneFailure() + try: + if not quiet: + print >>sys.stderr, 'Get %s' % url + while True: + buf = r.read(8192) + if buf == '': + return True + dest.write(buf) + finally: + r.close() + finally: + dest.close() + +def _ImportBundle(local): + path = os.path.join(local, '.git', 'clone.bundle') + try: + _Fetch(local, local, path, True) + finally: + os.remove(path) + +def _Clone(url, local, quiet): + """Clones a git repository to a new subdirectory of repodir + """ + try: + os.mkdir(local) + except OSError, e: + print >>sys.stderr, \ + 'fatal: cannot make %s directory: %s' \ + % (local, e.strerror) + raise CloneFailure() + + cmd = [GIT, 'init', '--quiet'] + try: + proc = subprocess.Popen(cmd, cwd = local) + except OSError, e: + print >>sys.stderr + print >>sys.stderr, "fatal: '%s' is not available" % GIT + print >>sys.stderr, 'fatal: %s' % e + print >>sys.stderr + print >>sys.stderr, 'Please make sure %s is installed'\ + ' and in your path.' % GIT + raise CloneFailure() + if proc.wait() != 0: + print >>sys.stderr, 'fatal: could not create %s' % local + raise CloneFailure() + + _InitHttp() + _SetConfig(local, 'remote.origin.url', url) + _SetConfig(local, 'remote.origin.fetch', + '+refs/heads/*:refs/remotes/origin/*') + if _DownloadBundle(url, local, quiet): + _ImportBundle(local) + else: + _Fetch(url, local, 'origin', quiet) + + +def _Verify(cwd, branch, quiet): + """Verify the branch has been signed by a tag. + """ + cmd = [GIT, 'describe', 'origin/%s' % branch] + proc = subprocess.Popen(cmd, + stdout=subprocess.PIPE, + stderr=subprocess.PIPE, + cwd = cwd) + cur = proc.stdout.read().strip() + proc.stdout.close() + + proc.stderr.read() + proc.stderr.close() + + if proc.wait() != 0 or not cur: + print >>sys.stderr + print >>sys.stderr,\ + "fatal: branch '%s' has not been signed" \ + % branch + raise CloneFailure() + + m = re.compile(r'^(.*)-[0-9]{1,}-g[0-9a-f]{1,}$').match(cur) + if m: + cur = m.group(1) + if not quiet: + print >>sys.stderr + print >>sys.stderr, \ + "info: Ignoring branch '%s'; using tagged release '%s'" \ + % (branch, cur) + print >>sys.stderr + + env = os.environ.copy() + env['GNUPGHOME'] = gpg_dir.encode() + + cmd = [GIT, 'tag', '-v', cur] + proc = subprocess.Popen(cmd, + stdout = subprocess.PIPE, + stderr = subprocess.PIPE, + cwd = cwd, + env = env) + out = proc.stdout.read() + proc.stdout.close() + + err = proc.stderr.read() + proc.stderr.close() + + if proc.wait() != 0: + print >>sys.stderr + print >>sys.stderr, out + print >>sys.stderr, err + print >>sys.stderr + raise CloneFailure() + return '%s^0' % cur + + +def _Checkout(cwd, branch, rev, quiet): + """Checkout an upstream branch into the repository and track it. + """ + cmd = [GIT, 'update-ref', 'refs/heads/default', rev] + if subprocess.Popen(cmd, cwd = cwd).wait() != 0: + raise CloneFailure() + + _SetConfig(cwd, 'branch.default.remote', 'origin') + _SetConfig(cwd, 'branch.default.merge', 'refs/heads/%s' % branch) + + cmd = [GIT, 'symbolic-ref', 'HEAD', 'refs/heads/default'] + if subprocess.Popen(cmd, cwd = cwd).wait() != 0: + raise CloneFailure() + + cmd = [GIT, 'read-tree', '--reset', '-u'] + if not quiet: + cmd.append('-v') + cmd.append('HEAD') + if subprocess.Popen(cmd, cwd = cwd).wait() != 0: + raise CloneFailure() + + +def _FindRepo(): + """Look for a repo installation, starting at the current directory. + """ + dir = os.getcwd() + repo = None + + olddir = None + while dir != '/' \ + and dir != olddir \ + and not repo: + repo = os.path.join(dir, repodir, REPO_MAIN) + if not os.path.isfile(repo): + repo = None + olddir = dir + dir = os.path.dirname(dir) + return (repo, os.path.join(dir, repodir)) + + +class _Options: + help = False + + +def _ParseArguments(args): + cmd = None + opt = _Options() + arg = [] + + for i in xrange(0, len(args)): + a = args[i] + if a == '-h' or a == '--help': + opt.help = True + + elif not a.startswith('-'): + cmd = a + arg = args[i + 1:] + break + return cmd, opt, arg + + +def _Usage(): + print >>sys.stderr,\ +"""usage: repo COMMAND [ARGS] + +repo is not yet installed. Use "repo init" to install it here. + +The most commonly used repo commands are: + + init Install repo in the current working directory + help Display detailed help on a command + +For access to the full online help, install repo ("repo init"). +""" + sys.exit(1) + + +def _Help(args): + if args: + if args[0] == 'init': + init_optparse.print_help() + sys.exit(0) + else: + print >>sys.stderr,\ + "error: '%s' is not a bootstrap command.\n"\ + ' For access to online help, install repo ("repo init").'\ + % args[0] + else: + _Usage() + sys.exit(1) + + +def _NotInstalled(): + print >>sys.stderr,\ +'error: repo is not installed. Use "repo init" to install it here.' + sys.exit(1) + + +def _NoCommands(cmd): + print >>sys.stderr,\ +"""error: command '%s' requires repo to be installed first. + Use "repo init" to install it here.""" % cmd + sys.exit(1) + + +def _RunSelf(wrapper_path): + my_dir = os.path.dirname(wrapper_path) + my_main = os.path.join(my_dir, 'main.py') + my_git = os.path.join(my_dir, '.git') + + if os.path.isfile(my_main) and os.path.isdir(my_git): + for name in ['git_config.py', + 'project.py', + 'subcmds']: + if not os.path.exists(os.path.join(my_dir, name)): + return None, None + return my_main, my_git + return None, None + + +def _SetDefaultsTo(gitdir): + global REPO_URL + global REPO_REV + + REPO_URL = gitdir + proc = subprocess.Popen([GIT, + '--git-dir=%s' % gitdir, + 'symbolic-ref', + 'HEAD'], + stdout = subprocess.PIPE, + stderr = subprocess.PIPE) + REPO_REV = proc.stdout.read().strip() + proc.stdout.close() + + proc.stderr.read() + proc.stderr.close() + + if proc.wait() != 0: + print >>sys.stderr, 'fatal: %s has no current branch' % gitdir + sys.exit(1) + + +def main(orig_args): + main, dir = _FindRepo() + cmd, opt, args = _ParseArguments(orig_args) + + wrapper_path = os.path.abspath(__file__) + my_main, my_git = _RunSelf(wrapper_path) + + if not main: + if opt.help: + _Usage() + if cmd == 'help': + _Help(args) + if not cmd: + _NotInstalled() + if cmd == 'init': + if my_git: + _SetDefaultsTo(my_git) + try: + _Init(args) + except CloneFailure: + for root, dirs, files in os.walk(repodir, topdown=False): + for name in files: + os.remove(os.path.join(root, name)) + for name in dirs: + os.rmdir(os.path.join(root, name)) + os.rmdir(repodir) + sys.exit(1) + main, dir = _FindRepo() + else: + _NoCommands(cmd) + + if my_main: + main = my_main + + ver_str = '.'.join(map(lambda x: str(x), VERSION)) + me = [main, + '--repo-dir=%s' % dir, + '--wrapper-version=%s' % ver_str, + '--wrapper-path=%s' % wrapper_path, + '--'] + me.extend(orig_args) + me.extend(extra_args) + try: + os.execv(main, me) + except OSError, e: + print >>sys.stderr, "fatal: unable to start %s" % main + print >>sys.stderr, "fatal: %s" % e + sys.exit(148) + + +if __name__ == '__main__': + main(sys.argv[1:]) diff --git a/misc/scan b/misc/scan new file mode 100755 index 0000000..0b4c9eb --- /dev/null +++ b/misc/scan @@ -0,0 +1 @@ +sudo pxscan --port=0x378 --pos=0.0x0.0 --dim=8.49554140127x11.7 --color=-30/0/1.0 --res=100 -n $HOME/scanned-image.tif diff --git a/misc/sed/entities.sed b/misc/sed/entities.sed new file mode 100644 index 0000000..b2b4929 --- /dev/null +++ b/misc/sed/entities.sed @@ -0,0 +1,24 @@ +s/á/\á/g +s/ã/\ã/g +s/â/\â/g +s/à/\à/g +s/é/\é/g +s/ê/\ê/g +s/í/\í/g +s/ó/\ó/g +s/õ/\õ/g +s/ô/\ô/g +s/ú/\ú/g +s/ç/\ç/g +s/Á/\Á/g +s/Ã/\Ã/g +s/Â/\Â/g +s/É/\É/g +s/Ê/\Ê/g +s/Í/\Í/g +s/Ó/\Ó/g +s/Õ/\Õ/g +s/Ô/\Ô/g +s/Ú/\Ú/g +s/Ç/\Ç/g +s/ñ/\ñ/g diff --git a/misc/sed/justify.sed b/misc/sed/justify.sed new file mode 100755 index 0000000..0a2e5af --- /dev/null +++ b/misc/sed/justify.sed @@ -0,0 +1,68 @@ +#!/bin/sed -f +# justify.sed - aurélio marinho jargas <verde (a) aurelio net> +# +# it gets a text already wrapped on the desired number of columns +# and add extra white spaces, from left to right, word by word, +# to justify all the lines. there is a maximum of 5 spaces to be +# inserted between the words. if this limit is reached, the line +# is not justified (come on, more than 5 is horrible). empty +# lines are ignored. btw, this comments were justified with this +# script &:) +# +# 20000715 1st release +# 20000722 code cleaned + +# cleaning extra spaces of the line +s/ \+/ /g +s/^ // +s/ $// + +# we'll only justify lines with less than 65 chars +/^.\{65\}/b + +# backup of the 'stripped' line +h + +# spaces -> pattern +# convert series of spaces to a internal pattern `n +:s2p +s/ /`5/g +s/ /`4/g +s/ /`3/g +s/ /`2/g +s/ /`1/g +t 1space +b + +# pattern -> spaces +# restore the spaces converted to the internal pattern `n +:p2s +s/`5/ /g +s/`4/ /g +s/`3/ /g +s/`2/ /g +s/`1/ /g +t check +b + +# check if we've reached our right limit +# if not, continue adding spaces +:check +/^.\{65\}/!b s2p +b + +# here's the "magic": +# add 1 space to the first and minor internal pattern found. +# this way, the extra spaces are always added from left to right, +# always balanced, one by one. +# right after the substitution, we'll restore the spaces and +# test if our limit was reached. +:1space +s/`1/`2/ ; t p2s +s/`2/`3/ ; t p2s +s/`3/`4/ ; t p2s +s/`4/`5/ ; t p2s + +# we don't want to justify with more than 5 added spaces between +# words, so let's restore the original line +/`5/x diff --git a/misc/sed/mail-iso2txt.sed b/misc/sed/mail-iso2txt.sed new file mode 100644 index 0000000..d3bf429 --- /dev/null +++ b/misc/sed/mail-iso2txt.sed @@ -0,0 +1,55 @@ +#!/bin/sed -f +# mail-iso2txt.sed - 20000906 <verde (a) aurelio net> +# convert the email encoded chars =xx to the right hexa char +# +# ps.: needs GNU sed >= 3.02.80 because the s//\xnn/ notation + +s|=09|\x09|g +s|=20|\x20|g +s|=B7|\xb7|g +s|=BA|\xba|g +s|=C1|\xc1|g +s|=C2|\xc2|g +s|=C3|\xc3|g +s|=C4|\xc4|g +s|=C5|\xc5|g +s|=C6|\xc6|g +s|=C7|\xc7|g +s|=C8|\xc8|g +s|=C9|\xc9|g +s|=CA|\xca|g +s|=CB|\xcb|g +s|=CC|\xcc|g +s|=CD|\xcd|g +s|=CE|\xce|g +s|=CF|\xcf|g +s|=D7|\xd7|g +s|=E1|\xe1|g +s|=E2|\xe2|g +s|=E3|\xe3|g +s|=E4|\xe4|g +s|=E5|\xe5|g +s|=E6|\xe6|g +s|=E7|\xe7|g +s|=E8|\xe8|g +s|=E9|\xe9|g +s|=EA|\xea|g +s|=EB|\xeb|g +s|=EC|\xec|g +s|=ED|\xed|g +s|=EE|\xee|g +s|=EF|\xef|g +s|=F1|\xf1|g +s|=F2|\xf2|g +s|=F3|\xf3|g +s|=F4|\xf4|g +s|=F5|\xf5|g +s|=F6|\xf6|g +s|=F7|\xf7|g +s|=F8|\xf8|g +s|=F9|\xf9|g +s|=FA|\xfa|g +s|=FB|\xfb|g +s|=FC|\xfc|g +s|=$||g + diff --git a/misc/sed/mini-html2latex.sed b/misc/sed/mini-html2latex.sed new file mode 100644 index 0000000..03fd2d5 --- /dev/null +++ b/misc/sed/mini-html2latex.sed @@ -0,0 +1,9 @@ +s/<strong>/\\section{/g +s/<\/strong>/}/g +s/<i>/\\emph{/g +s/<\/i>/}/g +s/<a href=\"/\\link{/g +s/\">/}{/g +s/<\/a>/}/g +s/<pre>/\\begin{verbatim}/g +s/<\/pre>/\\end{verbatim}/g diff --git a/misc/sed/syndication.sed b/misc/sed/syndication.sed new file mode 100644 index 0000000..4b6b195 --- /dev/null +++ b/misc/sed/syndication.sed @@ -0,0 +1,27 @@ +s/Â/\Â/g +s/â/\â/g +s/ã/\ã/g +s/é/\é/g +s/ô/\ô/g +s/á/\á/g +s/Ã/\Í/g +s/Ã/\í/g +s/ç/\ç/g +s/õ/\õ/g +s/ê/\ê/g +s/Ç/\Ç/g +s/Ã/\Ã/g +s/ó/\ó/g +s/ú/\ú/g +s/Ê/\Ê/g +s/É/\É/g +s/Ã/\Á/g +s/Ú/\Ú/g +s/á/\á/g +s/ê/\é/g +s/&aacute;/\á/g +s/&ecirc;/\ê/g +s/À/\À/g +s/–/\-/g +s/è/\è/g +s/Õ/\Õ/g diff --git a/misc/sed/twiki-to-tiki.sed b/misc/sed/twiki-to-tiki.sed new file mode 100755 index 0000000..d0fe2f5 --- /dev/null +++ b/misc/sed/twiki-to-tiki.sed @@ -0,0 +1,14 @@ +#!/bin/sed -f +# +# twiki-to-tiki.sed: formatting conversion +# feedback: rhatto@riseup.net +# + +s/^ \*/\*/ +s/---+++/\!\!\!/ +s/---++/\!\!\!/ +s/---+/\!/ +s/\*\([A-Za-z0-9]*\)\*/__\1__/g +s/<verbatim>/~pp\~/g +s/<\/verbatim>/~\/pp\~/g +s/%TOC%/{maketoc}/ diff --git a/misc/sed/unicode-zoado.sed b/misc/sed/unicode-zoado.sed new file mode 100644 index 0000000..c372a71 --- /dev/null +++ b/misc/sed/unicode-zoado.sed @@ -0,0 +1,11 @@ +s/á/\á/g +s/Ã/\í/g +s/ó/\ó/g +s/ç/\ç/g +s/õ/\õ/g +s/ã/\ã/g +s/â/\â/g +s/é/\é/g +s/ê/\ê/g +s/ó/\ó/g +s/â/\â/g diff --git a/misc/sed/wrap-forced.sed b/misc/sed/wrap-forced.sed new file mode 100755 index 0000000..e7f2cc9 --- /dev/null +++ b/misc/sed/wrap-forced.sed @@ -0,0 +1,46 @@ +#!/bin/sed -f +# wrap-forced.sed - wrap lines at column n +# +# acts like fmt, but ignores the 'word' context, +# wrapping the line exactly at the specified column +# +# pt_BR comments: +# funciona como o fmt, mas ignora o contexto de 'palavra' +# quebrando a linha exatamente na coluna especificada +# +# c1: na primeira linha do texto... +# c2: laço para colocar todas as linhas em 1 linha apenas +# c3: isto é para eliminar espaços em branco repetidos +# você pode comentá-lo se não quiser alterá-los +# c4: dica: tire o espaço da 2ª parte do comando s para +# apagar todos os espaços (parece arte ascii &:) ) +# c5: aqui é quem quebra a linha na coluna especificada +# mude o 25 para o número que você quiser +# o gnu-sed >= 3.02.80 é necessário por causa do \n +# +# 20000726 <verde (a) aurelio net> + +#c1: at the first line of the text... +1{ + + #c2: loop to put all the lines of the text at one single line + :a + $!N + s/\n// + ta + + #c3: + # this is to squeeze blanks + # you can comment it if you want blanks untouched + #c4: + # tip: take off the space at replacement part to have a result with + # NO spaces at all (looks like ascii art &:) ) + s/[[:blank:]]\+/ /g + + #c5: + # here is the guy who breaks the line at the specified column + # just change the 25 whatever column you like + # gnu-sed >= 3.02.80 required because the \n + s/.\{50\}/&\n/g +} + diff --git a/misc/sed/yahoogroups-kill-sig.sed b/misc/sed/yahoogroups-kill-sig.sed new file mode 100644 index 0000000..f7eb8c9 --- /dev/null +++ b/misc/sed/yahoogroups-kill-sig.sed @@ -0,0 +1,248 @@ +#!/bin/sed -f +# yahoogroups-kill-sig.sed by Aurelio Marinho Jargas +# +# Erases the Yahoo! Groups e-mail signature ad +# +# CHANGELOG: +# 20000??? v0.1 First one +# 20000725 v0.2 Now it has BEGIN/END marks, it's easier! +# 20000906 v0.3 Marks changed +# 20001107 v0.3.1 Contrib: Schlemer HTML killer +# ----- eGroups has changed to Yahoo! Groups ----- +# 20010206 v0.4 Contrib: Morcego's s/egroups/yahoo/s fix +# 20010716 v0.5 Marks changed again +# 20030428 v0.6 Policy Terms and Unsubscribe killers included +# 20030506 v0.6.1 One-char fix on the Policy killer, added SAMPLE DATA +# +# DESCRIPTION: +# Yahoogroups.com puts advertises on every sent message to the free groups. +# This file is a sed filter to erase it. It handles quoted '> ' ads also. +# If you do use procmail to filter e-mail messages, use this sed to +# automaticaly remove the Ads for every message you receive. +# +# HOW TO USE: +# Save this file on the disk and put at the begin of your ~/.procmailrc: +# :0 fhw +# * Delivered-To:.*@yahoogroups.com +# | sed -f /path/to/yahoogroups-kill-sig.sed +# +# If preferred, make this file executable (chmod +x), put it in your PATH and: +# :0 fhw +# * Delivered-To:.*@yahoogroups.com +# | yahoogroups-kill-sig.sed +# +# +# SAMPLE DATA FILE: +# You can use this sample data file to test these rules "by hand", +# before including them on the procmail file. +# Save the following fake e-mail message on a 'data.txt' file +# (remove the leading # chars!) and run: +# +# prompt$ sed -f yahoogroups-kill-sig.sed data.txt +# +# All the Ads and Yahoo! messages should be removed. +# +#---------------------------8<--------------------------- +#From: foo@foo.com +#To: foo@foo.com +#Subject: test me +# +#Here's the message body. +#And now, the evil sig. +# +#------------------------ Yahoo! Groups Sponsor ---------------------~--> +#Secure your servers with 128-bit SSL encryption! Grab your copy of +#VeriSign's FREE Guide "Securing Your Web Site for Business." Get it now! +#http://www.verisign.com/cgi-bin/go.cgi?a=n094442340008000 +#http://us.click.yahoo.com/6lIgYB/IWxCAA/yigFAA/dkFolB/TM +#---------------------------------------------------------------------~-> +# +#Your use of Yahoo! Groups is subject to +#http://docs.yahoo.com/info/terms/ +# +#To unsubscribe from this group, send an email to: +#foo-unsubscribe@yahoogroups.com +#--------------------------->8--------------------------- + + + +#------------------------------------------------------------------------- + + +# +----+ +# | Ad | +# +----+ +# +# Ad details: * a line w/ 24 hifens, 'Yahoo...Sponsor', 21 hifens and '~-->' +# * lines with yahoogroups propaganda +# * a line with 69 hifens, and '~->' at the end +# Ad Sample: +# ------------------------ Yahoo! Groups Sponsor ---------------------~--> +# Secure your servers with 128-bit SSL encryption! Grab your copy of +# VeriSign's FREE Guide "Securing Your Web Site for Business." Get it now! +# http://www.verisign.com/cgi-bin/go.cgi?a=n094442340008000 +# http://us.click.yahoo.com/6lIgYB/IWxCAA/yigFAA/dkFolB/TM +# ---------------------------------------------------------------------~-> +# +# Ad Killer: +/^\(> \)*-\{24\} Yahoo! Groups Sponsor -\{21\}~-->$/,/^\(> \)*-\{69\}~->$/d + + +#------------------------------------------------------------------------- + + +# +--------+ +# | Policy | +# +--------+ +# +# You can also remove the Policy Terms message. +# +# Policy Details: A one line message, sometimes broken into two, +# which appears at the very end of the message. +# Policy Sample: +# Your use of Yahoo! Groups is subject to http://docs.yahoo.com/info/terms/ +# +# Policy Killer: +/^\(> \)*Your use of Yahoo! Groups is subject to *$/N +/^\(> \)*Your use of Yahoo! Groups is subject to/d + + +#------------------------------------------------------------------------- + + +# +-------------+ +# | Unsubscribe | +# +-------------+ +# +# This one is to remove the *default* unsubscribe footer. +# +# Unsubscribe Details: A one line message, sometimes broken into two, +# which appears before the Ads. +# Unsubscribe Sample: +# To unsubscribe from this group, send an email to: +# foo-unsubscribe@yahoogroups.com +# +# Unsubscribe Killer: +/^\(> \)*To unsubscribe from this group, send an email to: *$/N +/^\(> \)*To unsubscribe from this group, send an email to:/d + + +#------------------------------------------------------------------------- + + +# +---------+ +# | Ad HTML | +# +---------+ +# +# For those who receive the Yahoo! messages in HTML (argh!), you may use +# this one also, because the HTML signature is way different. +# +# Ad Details: * an HTML comment with bar-star-star-bar,text,bar-star-star-bar +# * lines with egroups propaganda +# * an HTML comment with bar-star-star-bar,text,bar-star-star-bar +# Ad Sample: +# <!-- |**|begin egp html banner|**| --> +# +# <hr> +# <!-- |@|begin eGroups banner|@| runid: 8193 crid: 4101 --> +# <a target=3D"_blank" +# href=3D"http://click.egroups.com/1/8193/8/_/134812/_/9= +# 66089206/"><center> +# <img width=3D"468" height=3D"60" +# border=3D"0" +# alt=3D"" +# src=3D"http://adimg.egroups.com/img/8193/8/_/134812/_/966089206/468x60_ma= +# ze12k.gif"></center><center><font color=3D"black"></font></center></a> +# <!-- |@|end eGroups banner|@| --> +# <hr> +# +# <!-- |**|end egp html banner|**| --> +# +# Ad Killer: +#/^\(> \)*<!-- |\*\*|begin egp html banner|\*\*| -->$/,/^\(> \)*<!-- |\*\*|end egp html banner|\*\*| -->$/d + + + + + + +#------------------------------------------------------------------------- +# +-------------+ +# | OLD KILLERS | +# +-------------+ +#------------------------------------------------------------------------- +# +# +---------+ +# | Ad v0.4 | +# +---------+ +# +# Ad details: * a line w/ 24 hifens, 'Yahoo!...Sponsor', 21 hifens and '~-~>' +# * lines with yahoogroups propaganda +# * a line with 69 hifens, and '_->' at the end +# Ad Sample: +# ------------------------ Yahoo! Groups Sponsor ---------------------~-~> +# eGroups is now Yahoo! Groups +# Click here for more details +# http://click.egroups.com/1/11231/1/_/161736/_/980877852/ +# ---------------------------------------------------------------------_-> +# +# Ad Killer: +#/^\(> \)*-\{24\} Yahoo! Groups Sponsor -\{21\}~-~>$/,/^\(> \)*-\{69\}_->$/d' +# +#------------------------------------------------------------------------- +# +# +---------+ +# | Ad v0.3 | +# +---------+ +# +# Ad details: * a line w/ 26 hifens, 'eGroups Sponsor', 25 hifens and '~-~>' +# * lines with egroups propaganda +# * a line with 69 hifens, and '_->' at the end +# +# Ad Sample: +# -------------------------- eGroups Sponsor -------------------------~-~> +# GET A NEXTCARD VISA, in 30 seconds! Get rates +# of 2.9% Intro or 9.9% Ongoing APR* and no annual fee! +# Apply NOW! +# http://click.egroups.com/1/7872/14/_/_/_/967638075/ +# ---------------------------------------------------------------------_-> +# +# Ad Killer: +#/^\(> \)*-\{26\} eGroups Sponsor -\{25\}~-~>$/,/^\(> \)*-\{69\}_->$/d +# +#------------------------------------------------------------------------- +# +# +---------+ +# | Ad v0.2 | +# +---------+ +# +# Ad details: * a line with 68 hifens, an '<e|' and another hifen +# * lines with egroups propaganda +# * a line with 68 hifens, an '|e>' and another hifen +# Ad Sample: +# --------------------------------------------------------------------<e|- +# Huge Shoe Selection at Zappos.com +# (small sizes also available) +# http://click.egroups.com/1/7062/5/_/193628/_/964577029/ +# --------------------------------------------------------------------|e>- +# +# Ad Killer: +#/^\(> \)*-\{68\}<e|-$/,/^\(> \)*-\{68\}|e>-$/d +# +#------------------------------------------------------------------------- +# +# +---------+ +# | Ad v0.1 | +# +---------+ +# +# Ad Details: * a line with exactly 72 hifens before and after +# * any number of lines between +# * a line with 'http://click.egroups.com' +# Ad Sample: +# ------------------------------------------------------------------------ +# $60 in FREE Long Distance! Click Here to join beMANY! today. +# http://click.egroups.com/1/4126/10/_/_/_/958599956/ +# ------------------------------------------------------------------------ +# +# Ad Killer: +#/^\(> \)*-\{72\}$/{N;:l;/-\{72\}$/bs;N;bl;:s;s%^.*\n\(> \)*http://click\.egroups\.com.*%%;} diff --git a/misc/shell b/misc/shell new file mode 100755 index 0000000..ad86b8f --- /dev/null +++ b/misc/shell @@ -0,0 +1,6 @@ +#!/bin/bash +# +# shell: wrapper for a simple terminal console +# + +Eterm -g 110x45+320+90 +sb -f white -F smooth --borderless no --buttonbar 0 --scrollbar 0 -P None -nterminal diff --git a/misc/snownews b/misc/snownews new file mode 100755 index 0000000..3cf3a9f --- /dev/null +++ b/misc/snownews @@ -0,0 +1 @@ +Eterm --background-pixmap 0 --scrollbar 0 --buttonbar 0 -g 125x43+6-45 -F vga -n snownews -e snownews diff --git a/misc/splash.sh b/misc/splash.sh new file mode 100755 index 0000000..415f36e --- /dev/null +++ b/misc/splash.sh @@ -0,0 +1,7 @@ +#!/bin/bash + +if [ -z $2 ]; then echo "usage: $0 <kernel-version> <splash-theme>"; exit 1; fi + +cd /boot +mkinitrd -c $1 +splash -s -f /etc/bootsplash/themes/$2/config/bootsplash-1024x768.cfg >> /boot/initrd.gz diff --git a/misc/term-color b/misc/term-color new file mode 100755 index 0000000..85bf44b --- /dev/null +++ b/misc/term-color @@ -0,0 +1,43 @@ +#! /usr/bin/env python +# Copyright (C) 2006 by Johannes Zellner, <johannes@zellner.org> +# modified by mac@calmar.ws to fit my output needs +# modified by crncosta@carloscosta.org to fit my output needs +# pyroscope.project@gmail.com added a final "tput init", and changed the output format + +import os +import sys + +def echo(msg): + os.system('echo -n "' + str(msg) + '"') + +def out(n): + os.system("tput setab " + str(n) + "; echo -n " + ("\"% 4d\"" % n)) + os.system("tput setab 0") + +if os.getenv("TERM") in ("xterm", "screen"): + os.putenv("TERM", os.getenv("TERM") + "-256color") + +try: + # normal colors 1 - 16 + os.system("tput setaf 16") + for n in range(8): + out(n) + echo("\n") + for n in range(8, 16): + out(n) + + echo("\n") + echo("\n") + + y=16 + while y < 256: + for z in range(0,18): + out(y) + y += 1 + if y >= 256: break + + echo("\n") + + echo("\n") +finally: + os.system("tput init") diff --git a/misc/umount-tablet b/misc/umount-tablet new file mode 120000 index 0000000..ee40196 --- /dev/null +++ b/misc/umount-tablet @@ -0,0 +1 @@ +mount-tablet
\ No newline at end of file diff --git a/misc/wifi b/misc/wifi new file mode 100755 index 0000000..cfe6151 --- /dev/null +++ b/misc/wifi @@ -0,0 +1,16 @@ +#!/bin/bash +# +# Wifi initializer. +# + +#DEVICE="ath0" +DEVICE="wlan0" + +if [ ! -z "$1" ]; then + read -sp "Enter the WPA passphrase: " PASS + echo "" + wpa_passphrase $1 $PASS +elif [ -f "wpa_supplicant.conf" ]; then + sudo wpa_supplicant -B -Dwext -i$DEVICE -cwpa_supplicant.conf + sudo dhclient $DEVICE +fi diff --git a/misc/xbitchx b/misc/xbitchx new file mode 100755 index 0000000..e5b524e --- /dev/null +++ b/misc/xbitchx @@ -0,0 +1,20 @@ +#!/bin/bash +# +# xbitchx: execute bitchx under a X Terminal +# + +# Using rxvt +# rxvt -bg black +sb -fg white -fn vga -g 120x40+30+55 -name BitchX -e BitchX -p 994 -ssl irc.indymedia.org + +# Old version using Eterm +# Eterm --background-pixmap 0 --scrollbar 0 +sb -b black -f white -F vga --borderless no --buttonbar 0 \ +# -g 120x40+30+55 -nBitchX -e BitchX -p 994 -ssl irc.indymedia.org + +# Old version using feast and Eterm +# xfeast +# Eterm --background-pixmap 0 --scrollbar 0 +sb -b black -f white -F vga --borderless no --buttonbar 0 \ +# -g 120x40+30+55 -nBitchX -e BitchX -p 994 -ssl irc.indymedia.org + +# Current version +Eterm --background-pixmap 0 --scrollbar 0 +sb -b black -f white -F vga --borderless no --buttonbar 0 \ + -g 120x40+30+55 -nBitchX -e BitchX -p 6667 127.0.0.1 diff --git a/misc/xcamp b/misc/xcamp new file mode 100755 index 0000000..6ae9fd2 --- /dev/null +++ b/misc/xcamp @@ -0,0 +1,17 @@ +#!/bin/bash +# +# xcamp: wrapper for camp console music player +# + +# Set possible geometries +BOTTOM_LEFT="75x20+10+410" +BOTTOM_RIGHT="75x20+415+410" +TOP_LEFT="75x20+10+5" +TOP_RIGHT="75x20+415+5" +TOP_RIGHT_2="500+420" +TOP_RIGHT_3="500+385" + +# Set default geometry +GEOMETRY="$TOP_RIGHT_3" + +Eterm --trans -F VGA --scrollbar 0 --buttonbar 0 --borderless -g $GEOMETRY -e camp diff --git a/misc/xfeast b/misc/xfeast new file mode 100755 index 0000000..8a8504a --- /dev/null +++ b/misc/xfeast @@ -0,0 +1,15 @@ +#!/bin/bash +# +# xfeast: execute silc gateway +# + +pid="$HOME/tmp/silc.pid" +if [[ -f "$pid" ]]; then + if `ps $pid | grep -q $pid`; then + kill `cat $pid` + fi + rm $pid +fi +netcat -l -p 1706 -e "/usr/bin/feast .feast.conf" & +echo "$!" > $pid +trap "kill `cat $pid`" 2 15 diff --git a/misc/xgkrellm b/misc/xgkrellm new file mode 100755 index 0000000..857b85e --- /dev/null +++ b/misc/xgkrellm @@ -0,0 +1,7 @@ +#!/bin/bash +# +# xgrellm: wrapper for gkrellm +# + +#gkreallm -w +gkrellm -g +945+545 diff --git a/misc/xterm b/misc/xterm new file mode 100755 index 0000000..baebbce --- /dev/null +++ b/misc/xterm @@ -0,0 +1 @@ +xterm -bg black -fg white -font -misc-fixed-bold-*-*-*-*-*-*-*-*-*-*-* diff --git a/mutt-notmuch-tag b/mutt-notmuch-tag new file mode 100755 index 0000000..9b80a19 --- /dev/null +++ b/mutt-notmuch-tag @@ -0,0 +1,21 @@ +# mutt-notmuch-tag.sh +# Simple and crude script to tag multiple messagess in mutt using notmuch. +# See http://upsilon.cc/~zack/blog/posts/2011/01/how_to_use_Notmuch_with_Mutt/ + +grep "Message-ID" - > temp.txt +sed -e 's|Message-ID:.*<\(.*\)>.*|id:\1|' temp.txt > temp1.txt +sed '{:q;N;s/\n/ OR /g;t q}' temp1.txt > temp2.txt + +## When vi opens up list the tagging commands, e.g. +tag1 -tag2 +vi tags.txt + +TAGS=`cat tags.txt` +SEARCHEXPR=`cat temp2.txt` + +## For debugging +echo "notmuch tag $TAGS -- $SEARCHEXPR" >> temp2.txt + +## Now apply the tags +notmuch tag $TAGS -- $SEARCHEXPR + +# End of mutt-notmuch-tag.sh diff --git a/philter.py b/philter.py new file mode 100755 index 0000000..a712d54 --- /dev/null +++ b/philter.py @@ -0,0 +1,81 @@ +#! /usr/bin/python +# +# This is a slighted channged version of Philter available at +# http://philter.sourceforge.net written by Prabhakar V. Chaganti and +# distributed under GPLv2. +# +# Minor changes by rhatto at riseup.net. +# + +import ConfigParser, os, rfc822, re, string, posixpath + + +class Philter: + def __init__(self,match,header,destination,maildir): + self.re = re.compile(match) + self.header = header + self.destination = destination + self.maildir = maildir + + + def __str__(self): + return ("philter : \n \t match: %s \n\t header: %s \n\t destination: %s \n\t maildir: %s" % + (self.re,self.header,self.destination,self.maildir)) + + + +class PhilterDriver: + __propFile = open(string.join((posixpath.expanduser('~'),'/.philterrc'),'')) + __newDir = '/new' + + def createPhilters(self): + sections = PhilterDriver.__config.sections() + sections.sort() + philters=[] + maildir = PhilterDriver.__config.get('DEFAULT','maildir') + for section in sections: + philters.append(Philter((PhilterDriver.__config.get(section,'match')), + string.split(PhilterDriver.__config.get(section,'header'),','), + PhilterDriver.__config.get(section,'destination'), + string.join((maildir,'/',PhilterDriver.__config.get(section,'destination'),'/new'),''))) + return philters + + + def parseConfig(self): + PhilterDriver.__config = ConfigParser.ConfigParser() + PhilterDriver.__config.readfp(PhilterDriver.__propFile) + + + def philterMaildir(self, philters): + inbox = string.join([PhilterDriver.__config.get('DEFAULT','maildir'), + "/",PhilterDriver.__config.get('DEFAULT','inbox'), + PhilterDriver.__newDir],"") + newMessages = os.listdir(inbox) + maildir = PhilterDriver.__config.get('DEFAULT','maildir') + found = 0 + for newMessage in newMessages: + msg = rfc822.Message(open(string.join([inbox,"/",newMessage],""))) + for philter in philters: + for hdr in philter.header: + if msg.getheader(hdr): + if philter.re.search(string.lower(msg.getheader(hdr))): + os.rename(string.join((maildir,'INBOX/new/',newMessage),''), + string.join((philter.maildir,'/',newMessage),'')) + found = 1 + break + + if found: + found = 0 + break + + + def main(self): + driver = PhilterDriver() + driver.parseConfig() + philters = driver.createPhilters() + driver.philterMaildir(philters) + + + +if __name__ == '__main__': + PhilterDriver().main() diff --git a/philter.sh b/philter.sh new file mode 100755 index 0000000..e974b2d --- /dev/null +++ b/philter.sh @@ -0,0 +1,67 @@ +#!/bin/bash +# +# rhatto's maildir simple filter +# feedback: rhatto at riseup.net | gpl +# + +PREFILTER="$HOME/apps/scripts/philter.py" +BASE="$HOME/mail/" +MAILBOXES="$BASE/Sync/" +INBOXES="" +#TRASHCAN="$BASE/INBOX.Trash/cur" +TRASHCAN="$BASE/INBOX.Trash/new" +SUBJECT="yes" # wheter to filter subject +DEL="no" # delete the message +BOGOFILTER="yes" +FILTER="***SPAM***" + +# Load configuration +if [ -e "$HOME/.config/scripts/philter" ]; then + source $HOME/.config/scripts/philter +fi + +for account in $INBOXES; do + + NEWBOX="$MAILBOXES/$account/INBOX/new" + + if [ -x $PREFILTER ]; then + $PREFILTER + fi + + cont="0" + cd $NEWBOX + + for file in `ls -1`; do + if grep -m 1 -e "X-Bogosity" "$file" | grep -q "Spam"; then + mv "$file" "$TRASHCAN" + if [[ "$DEL" == "yes" ]]; then + rm "$TRASHCAN/$file" + fi + ((cont++)) + elif [[ "$BOGOFILTER" == "yes" ]]; then + # bogofilter + if cat $file | bogofilter -u -e -p | grep -q -e "^X-Bogosity: Spam, tests=bogofilter"; then + mv "$file" "$TRASHCAN" + if [[ "$DEL" == "yes" ]]; then + rm "$TRASHCAN/$file" + fi + ((cont++)) + fi + fi + done + + if [ ! -z "$SUBJECT" ]; then + for file in `ls -1`; do + if grep -m 1 "$FILTER" "$file" | grep -q "Subject"; then + mv "$file" "$TRASHCAN" + if [[ "$DEL" == "yes" ]]; then + rm "$TRASHCAN/$file" + fi + ((cont++)) + fi + done + fi + + echo "Total: $cont filtered messages for account $account." + +done diff --git a/playlist-get b/playlist-get new file mode 100755 index 0000000..b980566 --- /dev/null +++ b/playlist-get @@ -0,0 +1,34 @@ +#!/bin/bash +# +# Get files for playlist +# + +# Parameters +BASENAME="`basename $0`" +PLAYLIST="$1" +MEDIA="/var/cache/media/noise" +PLAYLISTS="/var/lib/mpd/playlists" + +if [ -z "$PLAYLIST" ]; then + echo "Usage: $BASENAME <playlist>" + + if [ -d "$PLAYLISTS" ]; then + echo "" + echo "Available playlists: " + ls $PLAYLISTS + fi + + exit 1 +elif [ ! -f "$PLAYLISTS/$PLAYLIST.m3u" ]; then + echo "No such playlist $PLAYLISTS/$PLAYLIST.m3u" + exit 1 +fi + +echo "Getting files from $PLAYLISTS/$PLAYLIST.m3u..." + +cat $PLAYLISTS/$PLAYLIST.m3u | while read file; do + dir="$(dirname "$file")" + base="$(basename "$file")" + ( cd "$MEDIA/$dir" && git annex get "$base" ) +done + diff --git a/refresh-keys b/refresh-keys new file mode 100755 index 0000000..90ddda4 --- /dev/null +++ b/refresh-keys @@ -0,0 +1,8 @@ +#!/bin/sh +# See http://pastebin.com/raw.php?i=XL0WAVSA + +for key in `gpg --list-keys --with-colons | grep "^pub" | cut -f5 -d":" | sort --random-sort` +do + usewithtor gpg --refresh-keys $key 2> /dev/null + sleep $(( ($RANDOM % 1000) + 1)) +done @@ -0,0 +1,73 @@ +#!/usr/bin/gawk -f +# +# sc2csv ver. 0.1 (2001/12/4) +# Copyright (C) 2001 SIGEHUZI Tomoo (tomoo@s.email.ne.jp) + +function pos(s, n, a) { + sub(/[0-9]*$/, " &", s); + n = split(s, a); + if (n != 2) return 1; + J = a[2]; + s = a[1]; + n = split(s, a, ""); + if (n < 1) return 1; + I = 0; + for (i = 1; i <= n; i++) { + if (a[i] !~ /^[A-Z]$/) return 1; + I = I * 26 + v[a[i]]; + } + if (I > N[J]) N[J] = I; + return 0; +} + + +function invalid_line() { + print "Invalid line:", $0 > "/dev/stderr"; + exit(1); +} + + +BEGIN { + nap = split("ABCDEFGHIJKLMNOPQRSTUVWXYZ", ap, ""); + for (i = 1; i <= nap; i++) v[ap[i]] = i - 1; +} + + +/^\#/ {next;} + + +/^goto / {next;} + + +{ + if (NF == 0) next; + if ($1 ~ /^fmt$/) next; + if (pos($2) || $3 != "=") invalid_line(); + val = $0; + sub(/^[^=]*= /, "", val); + if ($1 == "let") { + if (val ~ /^@dts\([0-9]*,[0-9]*,[0-9]*\)$/) { + split(substr(val, 6, length(val) - 6), date, ","); + a[I,J] = sprintf("%d/%d/%d", date[1], date[2], date[3]); + } + else a[I,J] = val; + } + else if ($1 ~ /^(left|right)string$/) { + if (val ~ /^".*"$/) { + s = substr(val, 2, length(val) - 2); + gsub(/\\t/, "\t", s); + gsub(/\\n/, "\n", s); + gsub(/\\"/, "\"\"", s); + a[I,J] = (s ~ /[,"\n\t]/) ? sprintf("\"%s\"", s) : s; + } + else a[I,J] = val; # Much left to be done. + } + else invalid_line(); +} + +END { + for (j = 0; j <= J; j++) { + for (i = 0; i < N[j]; i++) printf("%s,", a[i,j]); + print a[i,j]; + } +} @@ -0,0 +1,14 @@ +#!/bin/bash +# +# Chroot wrapper +# + +# Load configuration +if [ -e "$HOME/.config/scripts/chroot" ]; then + source $HOME/.config/scripts/chroot +fi + +xhost local:$CHROOT_USER +sudo su $CHROOT_USER -c "schroot -d /home/$CHROOT_USER -c squeeze -p skype" & +sleep 1 +xhost - diff --git a/ssh-agent-eval b/ssh-agent-eval new file mode 100755 index 0000000..3123967 --- /dev/null +++ b/ssh-agent-eval @@ -0,0 +1,46 @@ +#!/bin/bash +# +# Initializes the ssh-agent. +# + +# SSH Agent +#SSHAGENT=/usr/bin/ssh-agent +#SSHAGENTARGS="-s" +# +#function ssh_agent_eval_run { +# eval `$SSHAGENT $SSHAGENTARGS` &> /dev/null +# trap "ps $SSH_AGENT_PID &> /dev/null && kill $SSH_AGENT_PID" 0 +#} +# +#if [ "$1" == "-f" ]; then +# echo "Starting a new ssh-agent..." +# ssh_agent_eval_run +#elif [ -z "$SSH_AUTH_SOCK" -a -x "$SSHAGENT" ]; then +# ssh_agent_eval_run +#fi + +# See http://mah.everybody.org/docs/ssh + +SSH_ENV="$HOME/.ssh/environment" + +function start_agent { + echo "Initialising new SSH agent..." + /usr/bin/ssh-agent | sed 's/^echo/#echo/' > "${SSH_ENV}" + echo succeeded + chmod 600 "${SSH_ENV}" + . "${SSH_ENV}" > /dev/null + /usr/bin/ssh-add; + /usr/bin/monkeysphere subkey-to-ssh-agent +} + +# Source SSH settings, if applicable + +if [ -f "${SSH_ENV}" ]; then + . "${SSH_ENV}" > /dev/null + #ps ${SSH_AGENT_PID} doesn't work under cywgin + ps -ef | grep ${SSH_AGENT_PID} | grep ssh-agent$ > /dev/null || { + start_agent; + } +else + start_agent; +fi @@ -0,0 +1,47 @@ +#!/bin/bash +# +# This code is licensed under a Creative Commons License. +# http://creativecommons.org/licenses/by-nc-sa/3.0/ +# + +# +# show usage +# +function usage { + echo "SSL Wrapper scripts" + echo "Based on http://www.madboa.com/geek/openssl/" +} + +# +# usage: retrieve-cert.sh remote.host.name [port] +# +function retrieve { + REMHOST=$1 + REMPORT=${2:-443} + + echo |\ + openssl s_client -connect ${REMHOST}:${REMPORT} 2>&1 |\ + sed -ne '/-BEGIN CERTIFICATE-/,/-END CERTIFICATE-/p' +} + +# +# usage: fingerprint cert +# +function fingerprint { + openssl x509 -noout -in $1 -fingerprint + openssl x509 -noout -in $1 -fingerprint -md5 +} + +# Parse option +COMMAND="$1" +shift + +if [ "$COMMAND" == "retrieve" ]; then + retrieve $* +elif [ "$COMMAND" == "verify" ]; then + openssl verify $* +elif [ "$COMMAND" == "fingerprint" ]; then + fingerprint $* +else + usage +fi diff --git a/ssl-cert-check b/ssl-cert-check new file mode 100755 index 0000000..72de361 --- /dev/null +++ b/ssl-cert-check @@ -0,0 +1,705 @@ +#!/bin/bash +# +# Program: SSL Certificate Check <ssl-cert-check> +# +# Source code home: http://prefetch.net/code/ssl-cert-check +# +# Documentation: http://prefetch.net/articles/checkcertificate.html +# +# Author: Matty < matty91 at gmail dot com > +# +# Current Version: 3.21 +# +# Revision History: + +# Version 3.21 +# - Adjust e-mail checking to avoid exiting if notifications aren't enabled -- Nick Anderson +# - Added the number of days until expiration to the Nagios output -- Nick Anderson +# +# Version 3.20 +# - Fixed a bug in certificate length checking -- Tim Nowaczyk +# +# Version 3.19 +# - Added check to verify the certificate retrieved is valid +# +# Version 3.18 +# - Add support for connecting to FTP servers -- Paul A Sand +# +# Version 3.17 +# - Add support for connecting to imap servers -- Joerg Pareigis +# +# Version 3.16 +# - Add support for connecting to the mail sbmission port -- Luis E. Munoz +# +# Version 3.15 +# - Adjusted the file checking logic to use the correct certificate -- Maciej Szudejko +# - Add sbin to the default search paths for OpenBSD compatibility -- Alex Popov +# - Use cut instead of substring processing to ensure compatibility -- Alex Popov +# +# Version 3.14 +# - Fixed the Common Name parser to handle DN's where the CN is not the last item +# eg. EmailAddr -- Jason Brothers +# - Added the ability to grab the serial number -- Jason Brothers +# - Added the "-b" option to print results without a header -- Jason Brothers +# - Added the "-v" option for certificate validation -- Jason Brothers +# +# Version 3.13 +# - Updated the subject line to include the hostname as well as +# the common name embedded in the X509 certificate (if it's +# available) -- idea proposed by Mike Burns +# +# Version 3.12 +# - Updated the license to allow redistribution and modification +# +# Version 3.11 +# - Added ability to comment out lines in files passed +# to the "-f" option -- Brett Stauner +# - Fixed comment next to file processing logic +# +# Version 3.10 +# - Fixed POP3 port -- Simon Matter +# +# Version 3.9 +# - Switched binary location logic to use which utility +# +# Version 3.8 +# - Fixed display on 80 column displays +# - Cleaned up the formatting +# +# Version 3.7 +# - Fixed bug in NAGIOS tests -- Ben Allen +# +# Version 3.6 +# - Added support for certificates stored in PKCS#12 databases -- Ken Gallo +# - Cleaned up comments +# - Adjusted variables to be more consistent +# +# Version 3.5 +# - Added support for NAGIOS -- Quanah Gibson-Mount +# - Added additional checks for mail -- Quanah Gibson-Mount +# - Convert tabs to spaces -- Quanah Gibson-Mount +# - Cleaned up usage() routine +# - Added additional checks for openssl +# +# Version 3.4 +# - Added a missing "{" to line 364 -- Ken Gallo +# - Move mktemp to the start of the main body to avoid errors +# - Adjusted default binary paths to make sure the script just works +# w/ Solaris, BSD and Linux hosts +# +# Version 3.3 +# - Added common name from X.509 certificate file to E-mail body / header -- Doug Curtis +# - Fixed several documentation errors +# - Use mktemp to create temporary files +# - Convert printf, sed and awk to variables +# - Check for printf, sed, awk and mktemp binaries +# - Add additional logic to make sure mktemp returned a valid temporary file +# +# Version 3.2 +# - Added option to list certificates in the file passed to "-f". +# +# Version 3.1 +# - Added handling for starttls for smtp -- Marco Amrein +# - Added handling for starttls for pop3 (without s) -- Marco Amrein +# - Removed extra spacing at end of script +# +# Version 3.0 +# - Added "-i" option to print certificate issuer +# - Removed $0 from Subject line of outbound e-mails +# - Fixed some typographical errors +# - Removed redundant "-b" option +# +# Version 2.0 +# - Fixed an issue with e-mails formatting incorrectly +# - Added additional space to host column -- Darren-Perot Spruell +# - Replaced GNU date dependency with CHRIS F. A. JOHNSON's +# date2julian shell function. This routine can be found on +# page 170 of Chris's book "Shell Scripting Recipes: A +# Problem-Solution Approach," ISBN #1590594711. Julian function +# was created based on a post to comp.unix.shell by Tapani Tarvainen. +# - Cleaned up function descriptions +# - Removed several lines of redundant code +# - Adjusted the help message +# +# Version 1.1 +# - Added "-c" flag to report expiration status of a PEM encoded +# certificate -- Hampus Lundqvist +# - Updated the prints messages to display the reason a connection +# failed (connection refused, connection timeout, bad cert, etc) +# - Updated the GNU date checking routines +# - Added checks for each binary required +# - Added checks for connection timeouts +# - Added checks for GNU date +# - Added a "-h" option +# - Cleaned up the documentation +# +# Version 1.0 +# Initial Release +# +# Last Updated: 11-23-2010 +# +# Purpose: +# ssl-cert-check checks to see if a digital certificate in X.509 format +# has expired. ssl-cert-check can be run in interactive and batch mode, +# and provides facilities to alarm if a certificate is about to expire. +# +# License: +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# Requirements: +# Requires openssl +# +# Installation: +# Copy the shell script to a suitable location +# +# Tested platforms: +# -- Solaris 9 using /bin/bash +# -- Solaris 10 using /bin/bash +# -- OS X 10.4.2 using /bin/sh +# -- OpenBSD using /bin/sh +# -- FreeBSD using /bin/sh +# -- Redhat Enterprise Linux 3, 4, 5 & 6 +# +# Usage: +# Refer to the usage() sub-routine, or invoke ssl-cert-check +# with the "-h" option. +# +# Examples: +# Please refer to the following site for documentation and +# examples: +# http://prefetch.net/articles/checkcertificate.html +# + +PATH=/bin:/usr/bin:/sbin:/usr/sbin:/usr/local/bin:/usr/local/ssl/bin:/usr/sfw/bin +export PATH + +# Who to page when an expired certificate is detected (cmdline: -e) +ADMIN="root" + +# Number of days in the warning threshhold (cmdline: -x) +WARNDAYS=30 + +# If QUIET is set to TRUE, don't print anything on the console (cmdline: -q) +QUIET="FALSE" + +# Don't send E-mail by default (cmdline: -a) +ALARM="FALSE" + +# Don't run as a Nagios plugin by default (cmdline: -n) +NAGIOS="FALSE" + +# NULL out the PKCSDBPASSWD variable for later use (cmdline: -k) +PKCSDBPASSWD="" + +# Location of system binaries +AWK=$(which awk) +DATE=$(which date) +GREP=$(which grep) +OPENSSL=$(which openssl) +PRINTF=$(which printf) +SED=$(which sed) +MKTEMP=$(which mktemp) + +# Return code used by nagios. Initialize to 0. +RETCODE=0 + +# Set the default umask to be somewhat restrictive +umask 077 + +############################################################################# +# Purpose: Convert a date from MONTH-DAY-YEAR to Julian format +# Acknowledgements: Code was adapted from examples in the book +# "Shell Scripting Recipes: A Problem-Solution Approach" +# ( ISBN 1590594711 ) +# Arguments: +# $1 -> Month (e.g., 06) +# $2 -> Day (e.g., 08) +# $3 -> Year (e.g., 2006) +############################################################################# +date2julian() { + + if [ "${1} != "" ] && [ "${2} != "" ] && [ "${3}" != "" ] + then + ## Since leap years add aday at the end of February, + ## calculations are done from 1 March 0000 (a fictional year) + d2j_tmpmonth=$((12 * ${3} + ${1} - 3)) + + ## If it is not yet March, the year is changed to the previous year + d2j_tmpyear=$(( ${d2j_tmpmonth} / 12)) + + ## The number of days from 1 March 0000 is calculated + ## and the number of days from 1 Jan. 4713BC is added + echo $(( (734 * ${d2j_tmpmonth} + 15) / 24 + - 2 * ${d2j_tmpyear} + ${d2j_tmpyear}/4 + - ${d2j_tmpyear}/100 + ${d2j_tmpyear}/400 + $2 + 1721119 )) + else + echo 0 + fi +} + +############################################################################# +# Purpose: Convert a string month into an integer representation +# Arguments: +# $1 -> Month name (e.g., Sep) +############################################################################# +getmonth() +{ + case ${1} in + Jan) echo 1 ;; + Feb) echo 2 ;; + Mar) echo 3 ;; + Apr) echo 4 ;; + May) echo 5 ;; + Jun) echo 6 ;; + Jul) echo 7 ;; + Aug) echo 8 ;; + Sep) echo 9 ;; + Oct) echo 10 ;; + Nov) echo 11 ;; + Dec) echo 12 ;; + *) echo 0 ;; + esac +} + +############################################################################# +# Purpose: Calculate the number of seconds between two dates +# Arguments: +# $1 -> Date #1 +# $2 -> Date #2 +############################################################################# +date_diff() +{ + if [ "${1}" != "" ] && [ "${2}" != "" ] + then + echo $((${2} - ${1})) + else + echo 0 + fi +} + +##################################################################### +# Purpose: Print a line with the expiraton interval +# Arguments: +# $1 -> Hostname +# $2 -> TCP Port +# $3 -> Status of certification (e.g., expired or valid) +# $4 -> Date when certificate will expire +# $5 -> Days left until the certificate will expire +# $6 -> Issuer of the certificate +##################################################################### +prints() +{ + if [ "${QUIET}" != "TRUE" ] && [ "${ISSUER}" = "TRUE" ] && [ "${VALIDATION}" != "TRUE" ] + then + MIN_DATE=$(echo $4 | ${AWK} '{ print $1, $2, $4 }') + if [ "${NAGIOS}" == "TRUE" ] + then + ${PRINTF} "%-35s %-17s %-8s %-11s %-4s %-30s\n" "$1:$2" "$6" "$3" "$MIN_DATE" \|days="$5" + else + ${PRINTF} "%-35s %-17s %-8s %-11s %-4s %-30s\n" "$1:$2" "$6" "$3" "$MIN_DATE" "$5" + fi + elif [ "${QUIET}" != "TRUE" ] && [ "${ISSUER}" = "TRUE" ] && [ "${VALIDATION}" == "TRUE" ] + then + ${PRINTF} "%-35s %-35s %-32s %-17s\n" "$1:$2" "$7" "$8" "$6" + + elif [ "${QUIET}" != "TRUE" ] && [ "${VALIDATION}" != "TRUE" ] + then + MIN_DATE=$(echo $4 | ${AWK} '{ print $1, $2, $4 }') + if [ "${NAGIOS}" == "TRUE" ] + then + ${PRINTF} "%-47s %-12s %-12s %-4s %-30s\n" "$1:$2" "$3" "$MIN_DATE" \|days="$5" + else + ${PRINTF} "%-47s %-12s %-12s %-4s %-30s\n" "$1:$2" "$3" "$MIN_DATE" "$5" + fi + elif [ "${QUIET}" != "TRUE" ] && [ "${VALIDATION}" == "TRUE" ] + then + ${PRINTF} "%-35s %-35s %-32s\n" "$1:$2" "$7" "$8" + fi +} + + +#################################################### +# Purpose: Print a heading with the relevant columns +# Arguments: +# None +#################################################### +print_heading() +{ + if [ "${NOHEADER}" != "TRUE" ] + then + if [ "${QUIET}" != "TRUE" ] && [ "${ISSUER}" = "TRUE" ] && [ "${NAGIOS}" != "TRUE" ] && [ "${VALIDATION}" != "TRUE" ] + then + ${PRINTF} "\n%-35s %-17s %-8s %-11s %-4s\n" "Host" "Issuer" "Status" "Expires" "Days" + echo "----------------------------------- ----------------- -------- ----------- ----" + + elif [ "${QUIET}" != "TRUE" ] && [ "${ISSUER}" = "TRUE" ] && [ "${NAGIOS}" != "TRUE" ] && [ "${VALIDATION}" == "TRUE" ] + then + ${PRINTF} "\n%-35s %-35s %-32s %-17s\n" "Host" "Common Name" "Serial #" "Issuer" + echo "----------------------------------- ----------------------------------- -------------------------------- -----------------" + + elif [ "${QUIET}" != "TRUE" ] && [ "${NAGIOS}" != "TRUE" ] && [ "${VALIDATION}" != "TRUE" ] + then + ${PRINTF} "\n%-47s %-12s %-12s %-4s\n" "Host" "Status" "Expires" "Days" + echo "----------------------------------------------- ------------ ------------ ----" + + elif [ "${QUIET}" != "TRUE" ] && [ "${NAGIOS}" != "TRUE" ] && [ "${VALIDATION}" == "TRUE" ] + then + ${PRINTF} "\n%-35s %-35s %-32s\n" "Host" "Common Name" "Serial #" + echo "----------------------------------- ----------------------------------- --------------------------------" + fi + fi +} + + +########################################## +# Purpose: Describe how the script works +# Arguments: +# None +########################################## +usage() +{ + echo "Usage: $0 [ -e email address ] [ -x days ] [-q] [-a] [-b] [-h] [-i] [-n] [-v]" + echo " { [ -s common_name ] && [ -p port] } || { [ -f cert_file ] } || { [ -c certificate file ] }" + echo "" + echo " -a : Send a warning message through E-mail" + echo " -b : Will not print header" + echo " -c cert file : Print the expiration date for the PEM or PKCS12 formatted certificate in cert file" + echo " -e E-mail address : E-mail address to send expiration notices" + echo " -f cert file : File with a list of FQDNs and ports" + echo " -h : Print this screen" + echo " -i : Print the issuer of the certificate" + echo " -k password : PKCS12 file password" + echo " -n : Run as a Nagios plugin" + echo " -p port : Port to connect to (interactive mode)" + echo " -s commmon name : Server to connect to (interactive mode)" + echo " -q : Don't print anything on the console" + echo " -v : Only print validation data" + echo " -x days : Certificate expiration interval (eg. if cert_date < days)" + echo "" +} + + +########################################################################## +# Purpose: Connect to a server ($1) and port ($2) to see if a certificate +# has expired +# Arguments: +# $1 -> Server name +# $2 -> TCP port to connect to +########################################################################## +check_server_status() { + + + + if [ "_${2}" = "_smtp" -o "_${2}" = "_25" ] + then + TLSFLAG="-starttls smtp" + + elif [ "_${2}" = "_ftp" -o "_${2}" = "_21" ] + then + TLSFLAG="-starttls ftp" + + elif [ "_${2}" = "_pop3" -o "_${2}" = "_110" ] + then + TLSFLAG="-starttls pop3" + + elif [ "_${2}" = "_imap" -o "_${2}" = "_143" ] + then + TLSFLAG="-starttls imap" + + elif [ "_${2}" = "_submission" -o "_${2}" = "_587" ] + then + TLSFLAG="-starttls smtp -port ${2}" + else + TLSFLAG="" + fi + + echo "" | ${OPENSSL} s_client -connect ${1}:${2} ${TLSFLAG} 2> ${ERROR_TMP} 1> ${CERT_TMP} + + if ${GREP} -i "Connection refused" ${ERROR_TMP} > /dev/null + then + prints ${1} ${2} "Connection refused" "Unknown" + + elif ${GREP} -i "gethostbyname failure" ${ERROR_TMP} > /dev/null + then + prints ${1} ${2} "Cannot resolve domain" "Unknown" + + elif ${GREP} -i "Operation timed out" ${ERROR_TMP} > /dev/null + then + prints ${1} ${2} "Operation timed out" "Unknown" + + elif ${GREP} -i "ssl handshake failure" ${ERROR_TMP} > /dev/null + then + prints ${1} ${2} "SSL handshake failed" "Unknown" + + elif ${GREP} -i "connect: Connection timed out" ${ERROR_TMP} > /dev/null + then + prints ${1} ${2} "Connection timed out" "Unknown" + + else + check_file_status ${CERT_TMP} $1 $2 + fi +} + +##################################################### +### Check the expiration status of a certificate file +### Accepts three parameters: +### $1 -> certificate file to process +### $2 -> Server name +### $3 -> Port number of certificate +##################################################### +check_file_status() { + + CERTFILE=${1} + HOST=${2} + PORT=${3} + + ### Check to make sure the certificate file exists + if [ ! -r ${CERTFILE} ] || [ -z ${CERTFILE} ] + then + echo "ERROR: The file named ${CERTFILE} is unreadable or doesn't exist" + echo "ERROR: Please check to make sure the certificate for ${HOST}:${PORT} is valid" + RETCODE=1 + return + fi + + ### Grab the expiration date from the X.509 certificate + if [ "${PKCSDBPASSWD}" != "" ] + then + # Extract the certificate from the PKCS#12 database, and + # send the informational message to /dev/null + ${OPENSSL} pkcs12 -nokeys -in ${CERTFILE} \ + -out ${CERT_TMP} -password pass:${PKCSDBPASSWD} 2> /dev/null + + # Extract the expiration date from the certificate + CERTDATE=$(${OPENSSL} x509 -in ${CERT_TMP} -enddate -noout | \ + ${SED} 's/notAfter\=//') + + # Extract the issuer from the certificate + CERTISSUER=$(${OPENSSL} x509 -in ${CERT_TMP} -issuer -noout | \ + ${AWK} 'BEGIN {RS="/" } $0 ~ /^O=/ \ + { print substr($0,3,17)}') + + ### Grab the common name (CN) from the X.509 certificate + COMMONNAME=$(${OPENSSL} x509 -in ${CERT_TMP} -subject -noout | \ + ${SED} -e 's/.*CN=//' | \ + ${SED} -e 's/\/.*//') + + ### Grab the serial number from the X.509 certificate + SERIAL=$(${OPENSSL} x509 -in ${CERT_TMP} -serial -noout | \ + ${SED} -e 's/serial=//') + else + # Extract the expiration date from the ceriticate + CERTDATE=$(${OPENSSL} x509 -in ${CERTFILE} -enddate -noout | \ + ${SED} 's/notAfter\=//') + + # Extract the issuer from the certificate + CERTISSUER=$(${OPENSSL} x509 -in ${CERTFILE} -issuer -noout | \ + ${AWK} 'BEGIN {RS="/" } $0 ~ /^O=/ { print substr($0,3,17)}') + + ### Grab the common name (CN) from the X.509 certificate + COMMONNAME=$(${OPENSSL} x509 -in ${CERTFILE} -subject -noout | \ + ${SED} -e 's/.*CN=//' | \ + ${SED} -e 's/\/.*//') + ### Grab the serial number from the X.509 certificate + SERIAL=$(${OPENSSL} x509 -in ${CERTFILE} -serial -noout | \ + ${SED} -e 's/serial=//') + fi + + ### Split the result into parameters, and pass the relevant pieces to date2julian + set -- ${CERTDATE} + MONTH=$(getmonth ${1}) + + # Convert the date to seconds, and get the diff between NOW and the expiration date + CERTJULIAN=$(date2julian ${MONTH#0} ${2#0} ${4}) + CERTDIFF=$(date_diff ${NOWJULIAN} ${CERTJULIAN}) + + if [ ${CERTDIFF} -lt 0 ] + then + if [ "${ALARM}" = "TRUE" ] + then + echo "The SSL certificate for ${HOST} \"(CN: ${COMMONNAME})\" has expired!" \ + | ${MAIL} -s "Certificate for ${HOST} \"(CN: ${COMMONNAME})\" has expired!" ${ADMIN} + fi + + prints ${HOST} ${PORT} "Expired" "${CERTDATE}" "${CERTDIFF}" "${CERTISSUER}" "${COMMONNAME}" "${SERIAL}" + RETCODE=2 + + elif [ ${CERTDIFF} -lt ${WARNDAYS} ] + then + if [ "${ALARM}" = "TRUE" ] + then + echo "The SSL certificate for ${HOST} \"(CN: ${COMMONNAME})\" will expire on ${CERTDATE}" \ + | ${MAIL} -s "Certificate for ${HOST} \"(CN: ${COMMONNAME})\" will expire in ${WARNDAYS}-days or less" ${ADMIN} + fi + prints ${HOST} ${PORT} "Expiring" "${CERTDATE}" "${CERTDIFF}" "${CERTISSUER}" "${COMMONNAME}" "${SERIAL}" + RETCODE=1 + + else + prints ${HOST} ${PORT} "Valid" "${CERTDATE}" "${CERTDIFF}" "${CERTISSUER}" "${COMMONNAME}" "${SERIAL}" + RETCODE=0 + fi +} + +################################# +### Start of main program +################################# +while getopts abinve:f:c:hk:p:s:qx: option +do + case "${option}" + in + a) ALARM="TRUE";; + b) NOHEADER="TRUE";; + c) CERTFILE=${OPTARG};; + e) ADMIN=${OPTARG};; + f) SERVERFILE=$OPTARG;; + h) usage + exit 1;; + i) ISSUER="TRUE";; + k) PKCSDBPASSWD=${OPTARG};; + n) NAGIOS="TRUE";; + p) PORT=$OPTARG;; + s) HOST=$OPTARG;; + q) QUIET="TRUE";; + v) VALIDATION="TRUE";; + x) WARNDAYS=$OPTARG;; + \?) usage + exit 1;; + esac +done + +if [ -f /usr/bin/mailx ] +then + MAIL="/usr/bin/mailx" +else + if [ "${ALARM}" == "FALSE" ] + then + MAIL=$(which mail 2>/dev/null) + else + MAIL=$(which mail) + fi +fi + + +### Check to make sure a openssl utility is available +if [ ! -f ${OPENSSL} ] +then + echo "ERROR: The openssl binary does not exist in ${OPENSSL}." + echo "FIX: Please modify the \${OPENSSL} variable in the program header." + exit 1 +fi + +### Check to make sure a date utility is available +if [ ! -f ${DATE} ] +then + echo "ERROR: The date binary does not exist in ${DATE} ." + echo "FIX: Please modify the \${DATE} variable in the program header." + exit 1 +fi + +### Check to make sure a grep utility is available +if [ ! -f ${GREP} ] +then + echo "ERROR: The grep binary does not exist in ${GREP} ." + echo "FIX: Please modify the \${GREP} variable in the program header." + exit 1 +fi + +### Check to make sure the mktemp and printf utilities are available +if [ ! -f ${MKTEMP} ] || [ ! -f ${PRINTF} ] +then + echo "ERROR: Unable to locate the mktemp or printf binary." + echo "FIX: Please modify the \${MKTEMP} and \${PRINTF} variables in the program header." + exit 1 +fi + +### Check to make sure the sed and awk binaries are available +if [ ! -f ${SED} ] || [ ! -f ${AWK} ] +then + echo "ERROR: Unable to locate the sed or awk binary." + echo "FIX: Please modify the \${SED} and \${AWK} variables in the program header." + exit 1 +fi + +### CHeck to make sure a mail client is available it automated notifcations are requested +if [ "${ALARM}" = "TRUE" ] && [ ! -f ${MAIL} ] +then + echo "ERROR: You enabled automated alerts, but the mail binary could not be found." + echo "FIX: Please modify the ${MAIL} variable in the program header." + exit 1 +fi + +# Place to stash temporary files +CERT_TMP=$($MKTEMP /var/tmp/cert.XXXXXX) +ERROR_TMP=$($MKTEMP /var/tmp/error.XXXXXX) + +### Baseline the dates so we have something to compare to +MONTH=$(${DATE} "+%m") +DAY=$(${DATE} "+%d") +YEAR=$(${DATE} "+%Y") +NOWJULIAN=$(date2julian ${MONTH#0} ${DAY#0} ${YEAR}) + +### Touch the files prior to using them +if [ ! -z "${CERT_TMP}" ] && [ ! -z "${ERROR_TMP}" ] +then + touch ${CERT_TMP} ${ERROR_TMP} +else + echo "ERROR: Problem creating temporary files" + echo "FIX: Check that mktemp works on your system" + exit 1 +fi + +### If a HOST and PORT were passed on the cmdline, use those values +if [ "${HOST}" != "" ] && [ "${PORT}" != "" ] +then + print_heading + check_server_status "${HOST}" "${PORT}" + +### If a file is passed to the "-f" option on the command line, check +### each certificate or server / port combination in the file to see if +### they are about to expire +elif [ -f "${SERVERFILE}" ] +then + print_heading + while read HOST PORT + do + if [ "`echo ${HOST} | cut -c1`" = "#" ] + then + : + elif [ "$PORT" = "FILE" ] + then + check_file_status ${HOST} "FILE" "${HOST}" + else + check_server_status "${HOST}" "${PORT}" + fi + + done < ${SERVERFILE} + +### Check to see if the certificate in CERTFILE is about to expire +elif [ "${CERTFILE}" != "" ] +then + print_heading + check_file_status ${CERTFILE} "FILE" "${CERTFILE}" + +### There was an error, so print a detailed usage message and exit +else + usage + exit 1 +fi + +### Remove the temporary files +rm -f ${CERT_TMP} ${ERROR_TMP} + +### Exit with a success indicator +if [ "${NAGIOS}" = "TRUE" ]; then + exit $RETCODE +else + exit 0 +fi diff --git a/start-streaming b/start-streaming new file mode 100755 index 0000000..b324c55 --- /dev/null +++ b/start-streaming @@ -0,0 +1,65 @@ +#!/bin/bash +# +# thanks to rafael at riseup.net and +# http://current.workingdirectory.net/posts/2010/video4linux-and-audio/ +# http://mcs.hackitectura.net/tiki-index.php?page=live+stream+with+gstreamer +# https://en.wikibooks.org/wiki/Puredyne/Stream_Audio_and_Video#Gstreamer +# http://wm161.net/2011/03/02/anchorman/ +# +# needed packages: v4l-utils gstreamer-tools +# +# Example config: +# +# SERVER="icecast.example.org" +# PORT="8000" +# PASS="hackme" +# MOUNT="mount.ogv" +# NAME="Stream" +# DESC="Description" +# GENRE="Genre" +# URL="http://example.org" + +# Parameters +DATE="`date +%Y%m%d%H%M%S`" +BASE="~/.start-streaming" +CONFIG="$1" + +# Parsing +if [ -z "$CONFIG" ]; then + echo "usage: `basename $0` <config>" + exit 1 +fi + +mkdir -p $BASE + +if [ ! -f "$BASE/$CONFIG.conf" ]; then + echo "error: no $BASE/$CONFIG.conf found" + exit 1 +fi + +source $BASE/$CONFIG.conf + +#v4l2-ctl --set-input 1 + +# Video source: screen +gst-launch ximagesrc ! queue ! textoverlay text="$DESC" font-desc="50px" ! queue ! ffmpegcolorspace ! videoscale ! video/x-raw-yuv,width=320,height=240 ! theoraenc bitrate=100 ! queue ! oggmux name=mux alsasrc ! queue ! audioconvert ! vorbisenc bitrate=48000 ! queue ! mux. mux. ! tee name=tt ! queue ! filesink location=$DATE-$MOUNT tt. ! queue ! shout2send ip=$SERVER port=$PORT password=$PASS mount=/$MOUNT streamname="$NAME" description="$DESC" genre="$GENRE" url=$URL + +# Video source: camera +#gst-launch v4l2src ! queue ! textoverlay text="$DESC" font-desc="50px" ! queue ! ffmpegcolorspace ! videoscale ! video/x-raw-yuv,width=320,height=240 ! theoraenc bitrate=100 ! queue ! oggmux name=mux alsasrc ! queue ! audioconvert ! vorbisenc bitrate=48000 ! queue ! mux. mux. ! tee name=tt ! queue ! filesink location=$DATE-$MOUNT tt. ! queue ! shout2send ip=$SERVER port=$PORT password=$PASS mount=/$MOUNT streamname="$NAME" description="$DESC" genre="$GENRE" url=$URL + +# norm=NTSC does not work on debian squeeze +#gst-launch v4l2src norm=NTSC ! queue ! textoverlay text="$DESC" font-desc="50px" ! queue ! ffmpegcolorspace ! videoscale ! video/x-raw-yuv,width=320,height=240 ! theoraenc bitrate=100 ! queue ! oggmux name=mux alsasrc ! queue ! audioconvert ! vorbisenc bitrate=48000 ! queue ! mux. mux. ! tee name=tt ! queue ! filesink location=$MOUNT tt. ! queue ! shout2send ip=$SERVER port=$PORT password=$PASS mount=/$MOUNT streamname="$NAME" description="$DESC" genre="$GENRE" url=$URL + +#gst-launch v4l2src norm=NTSC ! queue ! ffmpegcolorspace ! videoscale ! video/x-raw-yuv,width=320,height=240 ! theoraenc bitrate=100 ! queue ! oggmux name=mux alsasrc ! queue ! audioconvert ! vorbisenc bitrate=48000 ! queue ! mux. mux. ! tee name=tt ! queue ! filesink location=$MOUNT tt. ! queue ! shout2send ip=$SERVER port=$PORT password=$PASS mount=/$MOUNT streamname="$NAME" description="$DESC" genre="$GENRE" url=$URL + +#gst-launch v4l2src norm=NTSC ! queue ! ffmpegcolorspace ! videoscale ! video/x-raw-yuv,width=320,height=240 ! theoraenc bitrate=100 ! queue ! oggmux name=mux alsasrc ! queue ! audioconvert ! vorbisenc bitrate=48000 ! queue ! mux. mux. ! queue ! shout2send ip=$SERVER port=$PORT password=$PASS mount=/$MOUNT streamname="$NAME" description="$DESC" genre="$GENRE" url=$URL + +#gst-launch v4l2src norm=NTSC ! queue ! ffmpegcolorspace ! videoscale ! video/x-raw-yuv,width=320,height=240 ! theoraenc bitrate=100 ! queue ! oggmux name=mux alsasrc ! queue ! audioconvert ! vorbisenc bitrate=48000 ! queue ! mux. mux. ! queue ! shout2send ip=orelha.radiolivre.org port=8000 password=SENHA mount=/MOUNT.ogv + +# gst-launch v4l2src ! queue ! ffmpegcolorspace ! videoscale ! video/x-raw-yuv,width=320,height=240 ! tee name=tscreen ! queue ! autovideosink tscreen. ! queue ! videorate ! video/x-raw-yuv,framerate=25/2 ! queue ! theoraenc quality=16 ! queue ! oggmux name=mux alsasrc ! queue ! audioconvert ! vorbisenc quality=0.2 ! queue ! queue ! mux. mux. ! queue ! tee name=tfile ! queue ! filesink location=stream.ogg tfile. ! queue ! shout2send ip=icecast.server port=8000 mount=test.ogg password=secret + +# gst-launch-0.10 webmmux name=mux streamable=true ! queue2 ! shout2send mount=/test.webm port=8000 password=teste ip=173.255.215.196 v4l2src ! video/x-raw-yuv,width=320,height=240 ! ffmpegcolorspace ! vp8enc bitrate=96000 threads=6 ! queue2 ! mux.video_0 alsasrc ! audio/x-raw-int,rate=24000,channels=1 ! queue2 ! audioconvert ! vorbisenc max-bitrate=48000 ! queue2 ! mux.audio_0 + +# gst-launch-0.10 webmmux name=mux streamable=true ! queue2 ! shout2send mount=/test.webm port=8000 password=teste ip=173.255.215.196 v4l2src ! video/x-raw-yuv,width=320,height=240 ! ffmpegcolorspace ! vp8enc bitrate=96000 threads=6 ! queue2 ! mux.video_0 audiotestsrc ! audioconvert ! vorbisenc max-bitrate=48000 ! queue2 ! mux.audio_0 + +# gst-launch-0.10 webmmux name=mux streamable=true ! queue2 ! shout2send mount=/test.webm port=8000 password=teste ip=173.255.215.196 v4l2src ! video/x-raw-yuv,width=320,height=240 ! ffmpegcolorspace ! vp8enc bitrate=96000 threads=0 ! queue2 ! mux.video_0 pulsesrc device="alsa_input.pci-0000_00_1b.0.analog-stereo" ! audioconvert ! vorbisenc max-bitrate=48000 ! queue2 ! mux.audio_0 diff --git a/terminal b/terminal new file mode 100755 index 0000000..8714715 --- /dev/null +++ b/terminal @@ -0,0 +1,30 @@ +#!/bin/bash +# +# terminal: terminal emulator wrapper +# + +source ~/.geometry || exit 1 + +if [ "$TERM" == "rxvt" ]; then + if [ ! -z "$1" ]; then + rxvt-unicode -bg black +sb -fg white -fn $FONT -g $GEOMETRY -title terminal \ + -e bash -rcfile $HOME/.terminal -c "$*" + else + rxvt-unicode -bg black +sb -fg white -fn $FONT -g $GEOMETRY -title terminal \ + -e bash -rcfile $HOME/.terminal + fi +elif [ "$TERM" == "Eterm" ]; then + if [ ! -z "$1" ]; then + Eterm --background-pixmap 0 --scrollbar 0 +sb -b black -f white -F $FONT --borderless no \ + --buttonbar 0 -g $GEOMETRY -nterminal -e bash -rcfile $HOME/.terminal -c "$*" + else + Eterm --background-pixmap 0 --scrollbar 0 +sb -b black -f white -F $FONT --borderless no \ + --buttonbar 0 -g $GEOMETRY -nterminal -e bash -rcfile $HOME/.terminal + fi +elif [ "$TERM" == "xterm" ]; then + if [ ! -z "$1" ]; then + xterm -u8 -fn $FONT -geometry $GEOMETRY -title terminal -e bash -c "$*" + else + xterm -u8 -fn $FONT -geometry $GEOMETRY -title terminal -e bash + fi +fi diff --git a/tor-browser b/tor-browser new file mode 100755 index 0000000..678fa23 --- /dev/null +++ b/tor-browser @@ -0,0 +1 @@ +$HOME/apps/tor-browser/`uname -m`/start-tor-browser @@ -0,0 +1,6670 @@ +#!/usr/bin/perl -s +######################################################################### +# +# TTYtter v1.2 (c)2007-2011 cameron kaiser (and contributors). +# all rights reserved. +# http://www.floodgap.com/software/ttytter/ +# +# distributed under the floodgap free software license +# http://www.floodgap.com/software/ffsl/ +# +# After all, we're flesh and blood. -- Oingo Boingo +# If someone writes an app and no one uses it, does his code run? -- me +# +######################################################################### + +require 5.005; + +BEGIN { + # ONLY STUFF THAT MUST RUN BEFORE INITIALIZATION GOES HERE! + # THIS FUNCTION HAS GOTTEN TOO DAMN CLUTTERED! + +# @INC = (); # wreck intentionally for testing + + # this doesn't work for 5.14.0 (see Perl bug 92246) + if ($ENV{'PERL_SIGNALS'} ne 'unsafe' && $] >= 5.014) { + print STDOUT <<"EOF"; +TTYtter requires 'unsafe' Perl signals (which are of course for its +purposes perfectly safe). unfortunately, due to Perl bug 92246 5.14+ cannot +set this feature itself. set in your environment either of + +export PERL_SIGNALS=unsafe # sh, bash, ksh, etc. +setenv PERL_SIGNALS unsafe # csh, tcsh, etc. + +and restart TTYtter, or use Perl 5.12 or earlier. +EOF + exit; + } + $ENV{'PERL_SIGNALS'} = 'unsafe'; + + $command_line = $0; $0 = "TTYtter"; + $TTYtter_VERSION = "1.2"; + $TTYtter_PATCH_VERSION = 2; + $TTYtter_RC_NUMBER = 0; # non-zero for release candidate + # this is kludgy, yes. + $LANG = $ENV{'LANG'} || $ENV{'GDM_LANG'} || $ENV{'LC_CTYPE'} || + $ENV{'ALL'}; + $my_version_string = "${TTYtter_VERSION}.${TTYtter_PATCH_VERSION}"; + (warn ("$my_version_string\n"), exit) if ($version); + + $space_pad = " " x 1024; + + # for multi-module extension handling + $multi_module_mode = 0; + $multi_module_context = 0; + $muffle_server_messages = 0; + undef $master_store; + undef %push_stack; + + $padded_patch_version = substr($TTYtter_PATCH_VERSION . " ", 0, 2); + + %opts_boolean = map { $_ => 1 } qw( + ansi noansi verbose superverbose ttytteristas noprompt + seven silent hold daemon script anonymous readline ssl + newline vcheck verify noratelimit notrack nonewrts notimeline + synch exception_is_maskable mentions simplestart freezebug + location oldstatus readlinerepaint nocounter notifyquiet + ); %opts_sync = map { $_ => 1 } qw( + ansi pause dmpause ttytteristas verbose superverbose + url rlurl dmurl newline wrap notimeline lists dmidurl + queryurl trendurl track colourprompt colourme notrack + colourdm colourreply colourwarn coloursearch colourlist idurl + notifies filter colourdefault backload searchhits dmsenturl + ); %opts_urls = map {$_ => 1} qw( + url dmurl uurl rurl wurl frurl rlurl update shorturl + apibase queryurl trendurl idurl delurl dmdelurl favsurl + myfavsurl favurl favdelurl rtsofmeurl followurl leaveurl + dmupdate xauthurl credurl blockurl blockdelurl friendsurl + modifyliurl adduliurl delliurl getliurl getlisurl getfliurl + getuliurl getufliurl dmsenturl rturl rtsbyurl dmidurl + statusliurl followliurl leaveliurl followersurl + oauthurl oauthauthurl oauthaccurl oauthbase + ); %opts_secret = map { $_ => 1} qw( + superverbose ttytteristas + ); %opts_comma_delimit = map { $_ => 1 } qw( + lists notifytype notifies + ); %opts_space_delimit = map { $_ => 1 } qw( + track + ); + + %opts_can_set = map { $_ => 1 } qw( + url pause dmurl dmpause superverbose ansi verbose + update uurl rurl wurl avatar ttytteristas frurl track + rlurl noprompt shorturl newline wrap verify autosplit + notimeline queryurl trendurl colourprompt colourme + colourdm colourreply colourwarn coloursearch colourlist idurl + urlopen delurl notrack dmdelurl favsurl myfavsurl + favurl favdelurl slowpost notifies filter colourdefault + rtsofmeurl followurl leaveurl dmupdate mentions backload + lat long location searchhits blockurl blockdelurl + nocounter linelength friendsurl followersurl lists + modifyliurl adduliurl delliurl getliurl getlisurl getfliurl + getuliurl getufliurl dmsenturl rturl rtsbyurl + statusliurl followliurl leaveliurl dmidurl + ); %opts_others = map { $_ => 1 } qw( + lynx curl seven silent maxhist noansi hold status + daemon timestamp twarg user anonymous script readline + leader ssl rc norc vcheck apibase notifytype exts + nonewrts synch runcommand authtype oauthkey oauthsecret + tokenkey tokensecret xauthurl credurl keyf readlinerepaint + oldstatus simplestart freezebug exception_is_maskable oldperl + notify_tool_path oauthurl oauthauthurl oauthaccurl oauthbase + ); %valid = (%opts_can_set, %opts_others); + $rc = (defined($rc) && length($rc)) ? $rc : ""; + unless ($norc) { + my $rcf = + ($rc =~ m#^/#) ? $rc : "$ENV{'HOME'}/.ttytterrc${rc}"; + if (open(W, $rcf)) { + # 5.14 sets this lazily, so this gives us a way out + eval 'binmode(W, ":utf8")' unless ($seven); + while(<W>) { + chomp; + next if (/^\s*$/ || /^#/); + s/^-//; + ($key, $value) = split(/\=/, $_, 2); + if ($key eq 'rc') { + warn "** that's stupid, setting rc in an rc file\n"; + } elsif ($key eq 'norc') { + warn "** that's dumb, using norc in an rc file\n"; + } elsif (length $$key) { + ; # carry on + } elsif ($valid{$key} && !length($$key)) { + $$key = $value; + } elsif ($key =~ /^extpref_/) { + $$key = $value; + } elsif (!$valid{$key}) { + warn "** setting $key not supported in this version\n"; + } + } + close(W); + } elsif (length($rc)) { + die("couldn't access rc file $rcf: $!\n". + "to use defaults, use -norc or don't specify the -rc option.\n\n"); + } + } + $seven ||= 0; + $oldperl ||= 0; + $parent = $$; + $script = 1 if (length($runcommand)); + $supreturnto = $verbose + 0; + $postbreak_time = 0; + $postbreak_count = 0; + + # our minimum official support is now 5.8.6. + if ($] < 5.008006 && !$oldperl) { + die(<<"EOF"); + +*** you are using a version of Perl in "extended" support: $] *** +the minimum tested version of Perl required by TTYtter 1.2+ is 5.8.6. + +Perl 5.005 thru 5.8.5 probably can still run TTYtter, but they are not +tested with it. if you want to suppress this warning, specify -oldperl on +the command line, or put oldperl=1 in your .ttytterrc. bug patches will +still be accepted for older Perls; see the TTYtter home page for info. + +for Perl 5.005, remember to also specify -seven. + +EOF + } + + # defaults that our extensions can override + $last_id = 0; + $last_dm = 0; + # a correct fix for -daemon would make this unlimited, but this + # is good enough for now. + $print_max ||= ($daemon) ? 999999 : 250; # shiver + + $suspend_output = -1; + + # try to find an OAuth keyfile if we haven't specified key+secret + # no worries if this fails; we could be Basic Auth, after all + $whine = (length($keyf)) ? 1 : 0; + $keyf ||= "$ENV{'HOME'}/.ttytterkey"; + $keyf = "$ENV{'HOME'}/.ttytterkey${keyf}" if ($keyf !~ m#/#); + $attempted_keyf = $keyf; + if (!length($oauthkey) && !length($oauthsecret) # set later + && !length($tokenkey) + && !length($tokensecret) && !$oauthwizard) { + my $keybuf = ''; + if(open(W, $keyf)) { + while(<W>) { + chomp; + s/\s+//g; + $keybuf .= $_; + } + close(W); + my (@pairs) = split(/\&/, $keybuf); + foreach(@pairs) { + my (@pair) = split(/\=/, $_, 2); + $oauthkey = $pair[1] + if ($pair[0] eq 'ck'); + $oauthsecret = $pair[1] + if ($pair[0] eq 'cs'); + $tokenkey = $pair[1] + if ($pair[0] eq 'at'); + $tokensecret = $pair[1] + if ($pair[0] eq 'ats'); + } + die("** tried to load OAuth tokens from $keyf\n". + " but it seems corrupt or incomplete. please see the documentation,\n". + " or delete the file so that we can try making your keyfile again.\n") + if ((!length($oauthkey) || + !length($oauthsecret) || + !length($tokenkey) || + !length($tokensecret))); + } else { + die("** couldn't open keyfile $keyf: $!\n". + "if you want to run the OAuth wizard to create this file, add ". + "-oauthwizard\n") + if ($whine); + $keyf = ''; # i.e., we loaded nothing from a key file + } + } + + # try to init Term::ReadLine if it was requested + # (shakes fist at @br3nda, it's all her fault) + %readline_completion = (); + if ($readline && !$silent && !$script) { + $ENV{"PERL_RL"} = "TTYtter" if (!length($ENV{'PERL_RL'})); + eval +'use Term::ReadLine; $termrl = new Term::ReadLine ("TTYtter", \*STDIN, \*STDOUT)' + || die( + "$@\nthis perl doesn't have ReadLine. don't use -readline.\n"); + $stdout = $termrl->OUT || \*STDOUT; + $stdin = $termrl->IN || \*STDIN; + $readline = '' if ($readline eq '1'); + $readline =~ s/^"//; # for optimizer + $readline =~ s/"$//; + #$termrl->Attribs()->{'autohistory'} = undef; # not yet + (%readline_completion) = map {$_ => 1} split(/\s+/, $readline); + %original_readline = %readline_completion; + # readline repaint can't be tested here. we cache our + # result later. + } else { + $stdout = \*STDOUT; + $stdin = \*STDIN; + } + $wrapseq = 0; + $lastlinelength = -1; + + print $stdout "$leader\n" if (length($leader)); + + # state information + $lasttwit = ''; + $lastpostid = 0; + + # stub namespace for multimodules and (eventually) state saving + undef %store; + $store = \%store; + + $pack_magic = ($] < 5.006) ? '' : "U0"; + $utf8_encode = sub { ; }; + $utf8_decode = sub { ; }; + unless ($seven) { + eval +'use utf8;binmode($stdin,":utf8");binmode($stdout,":utf8");return 1' || + die("$@\nthis perl doesn't fully support UTF-8. use -seven.\n"); + + # this is for the prinput utf8 validator. + # adapted from http://mail.nl.linux.org/linux-utf8/2003-03/msg00087.html + # eventually this will be removed when 5.6.x support is removed, + # and Perl will do the UTF-8 validation for us. + $badutf8='[\x00-\x7f][\x80-\xbf]+|^[\x80-\xbf]+|'. + '[\xc0-\xdf][\x00-\x7f\xc0-\xff]|'. + '[\xc0-\xdf][\x80-\xbf]{2}|'. + '[\xe0-\xef][\x80-\xbf]{0,1}[\x00-\x7f\xc0-\xff]|'. + '[\xe0-\xef][\x80-\xbf]{3}|'. + '[\xf0-\xf7][\x80-\xbf]{0,2}[\x00-\x7f\xc0-\xff]|'. + '[\xf0-\xf7][\x80-\xbf]{4}|'. + '[\xf8-\xfb][\x80-\xbf]{0,3}[\x00-\x7f\xc0-\xff]|'. + '[\xf8-\xfb][\x80-\xbf]{5}|'. + '[\xfc-\xfd][\x80-\xbf]{0,4}[\x00-\x7f\xc0-\xff]|'. + '\xed[\xa0-\xbf][\x80-\xbf]|'. + '\xef\xbf[\xbe-\xbf]|'. + '[\xf0-\xf7][\x8f,\x9f,\xaf,\xbf]\xbf[\xbe-\xbf]|'. + '\xfe|\xff|'. + '[\xc0-\xc1][\x80-\xbf]|'. + '\xe0[\x80-\x9f][\x80-\xbf]|'. + '\xf0[\x80-\x8f][\x80-\xbf]{2}|'. + '\xf8[\x80-\x87][\x80-\xbf]{3}|'. + '\xfc[\x80-\x83][\x80-\xbf]{4}'; # gah! + + eval <<'EOF'; + $utf8_encode = sub { utf8::encode(shift); }; + $utf8_decode = sub { utf8::decode(shift); }; +EOF + } + $wraptime = sub { my $x = shift; return ($x, $x); }; + if ($timestamp) { + my $fail = "-- can't use custom timestamps.\nspecify -timestamp by itself to use Twitter's without module.\n"; + if (length($timestamp) > 1) { # pattern specified + eval 'use Date::Parse;return 1' || + die("$@\nno Date::Parse $fail"); + eval 'use Date::Format;return 1' || + die("$@\nno Date::Format $fail"); + $timestamp = "%Y-%m-%d %k:%M:%S" + if ($timestamp eq "default" || + $timestamp eq "def"); + $wraptime = sub { + my $time = str2time(shift); + my $stime = time2str($timestamp, $time); + return ($time, $stime); + }; + } + } +} +END { + &killkid unless ($in_backticks); # this is disgusting +} + +#### COMMON STARTUP #### + +# do we have POSIX::Termios? (usually we do) +eval 'use POSIX; $termios = new POSIX::Termios;'; +print $stdout "-- termios test: $termios\n" if ($verbose); + +# wrap warning +die( +"** dude, what the hell kind of terminal can't handle a 5 character line?\n") + if ($wrap > 1 && $wrap < 5); +print $stdout "** warning: prompts not wrapped for wrap < 70\n" + if ($wrap > 1 && $wrap < 70); + +# reject stupid combinations +die("you can't use automatic ratelimits with -noratelimit.\nuse -pause=#sec\n") + if ($noratelimit && $pause eq 'auto'); +die("you can't use -synch with -script or -daemon.\n") + if ($synch && ($script || $daemon)); +die("-script and -daemon cannot be used together.\n") + if ($script && $daemon); + +# set up menu codes and caches +$is_background = 0; +$alphabet = "abcdefghijkLmnopqrstuvwxyz"; +%store_hash = (); +$mini_split = 250; # i.e., 10 tweets for the mini-menu (/th) +# leaving 50 tweets for the foreground temporary menus +$tweet_counter = 0; +%dm_store_hash = (); +$dm_counter = 0; +%id_cache = (); +%filter_next = (); + +# set up threading management +$in_reply_to = 0; +$expected_tweet_ref = undef; + +# interpret -script at this level +if ($script) { + $noansi = $noprompt = 1; + $silent = ($verbose) ? 0 : 1; + $pause = $vcheck = $slowpost = $verify = 0; +} + + +### now instantiate the TTYtter dynamic API ### +### based off the defaults later in script. #### + +# first we need to load any extensions specified by -exts. +if (length($exts) && $exts ne '0') { + $multi_module_mode = -1; # mark as loader stage + + print "** attempting to load extensions\n" unless ($silent); + # unescape \, + $j=0; $xstring = "ESCAPED_STRING"; + while($exts =~ /$xstring$j/) { $j++; } + $xstring .= $j; + $exts =~ s/\\,/$xstring/g; + foreach $file (split(/,/, $exts)) { +#TODO +# wildcards? + $file =~ s/$xstring/,/g; + print "** loading $file\n" unless ($silent); + + die("** sorry, you cannot load the same extension twice.\n") + if ($master_store->{$file}->{'loaded'}); + + # prepare its working space in $store and load the module + $master_store->{$file} = { 'loaded' => 1 }; + $store = \%{ $master_store->{$file} }; + $EM_DONT_CARE = 0; + $EM_SCRIPT_ON = 1; + $EM_SCRIPT_OFF = -1; + $extension_mode = $EM_DONT_CARE; + die("** file not found: $!\n") if (! -r "$file"); + require $file; # and die if bad + die("** failed to load: $@\n") if ($@); + die("** consistency failure: reference failure\n") + if (!$store->{'loaded'}); + + # check type of extension (interactive or non-interactive). if + # we are in the wrong mode, bail out. + if ($extension_mode) { + die( +"** this extension requires -script. this may conflict with other extensions\n". +" you are loading, which may have their own requirements.\n") + if ($extension_mode == $EM_SCRIPT_ON && !$script); + die( +"** this extension cannot work with -script. this may conflict with other\n". +" extensions you are loading, which may have their own requirements.\n") + if ($extension_mode == $EM_SCRIPT_OFF && $script); + } + + # pick off all the subroutine references it makes for storage + # in an array to iterate and chain over later. + + # these methods are multi-module safe + foreach $arry (qw( + handle exception tweettype conclude dmhandle dmconclude + heartbeat precommand prepost postpost addaction + listhandle userhandle shutdown)) { + if (defined($$arry)) { + $aarry = "m_$arry"; + push(@$aarry, [ $file, $$arry ]); + undef $$arry; + } + } + # these methods are NOT multi-module safe + # if a extension already hooked one of + # these and another extension tries to hook it, fatal error. + foreach $arry (qw( + getpassword prompt main autocompletion)) { + if (defined($$arry)) { + $sarry = "l_$arry"; + if (defined($$sarry)) { + die( +"** double hook of unsafe method \"$arry\" -- you cannot use this extension\n". +" with the other extensions you are loading. see the documentation.\n"); + } + $$sarry = $$arry; + undef $$arry; + } + } + } + # success! enable multi-module support in the TTYtter API and then + # dispatch calls through the multi-module system instead. + $multi_module_mode = 1; # mark as completed loader + + $handle = \&multihandle; + $exception = \&multiexception; + $tweettype = \&multitweettype; + $conclude = \&multiconclude; + $dmhandle = \&multidmhandle; + $dmconclude = \&multidmconclude; + $heartbeat = \&multiheartbeat; + $precommand = \&multiprecommand; + $prepost = \&multiprepost; + $postpost = \&multipostpost; + $addaction = \&multiaddaction; + $shutdown = \&multishutdown; + $userhandle = \&multiuserhandle; + $listhandle = \&multilisthandle; +} else { + # the old API single-end-point system + + $multi_module_mode = 0; # not executing multi module endpoints + + $handle = \&defaulthandle; + $exception = \&defaultexception; + $tweettype = \&defaulttweettype; + $conclude = \&defaultconclude; + $dmhandle = \&defaultdmhandle; + $dmconclude = \&defaultdmconclude; + $heartbeat = \&defaultheartbeat; + $precommand = \&defaultprecommand; + $prepost = \&defaultprepost; + $postpost = \&defaultpostpost; + $addaction = \&defaultaddaction; + $shutdown = \&defaultshutdown; + $userhandle = \&defaultuserhandle; + $listhandle = \&defaultlisthandle; +} + +# unsafe methods use the single-end-point +$prompt = $l_prompt || \&defaultprompt; +$main = $l_main || \&defaultmain; +$getpassword = $l_getpassword || \&defaultgetpassword; + +# $autocompletion is special: +if ($termrl) { + $termrl->Attribs()->{'completion_function'} = + $l_autocompletion || \&defaultautocompletion; +} + +# fetch_id is based off last_id, if an extension set it +$fetch_id = $last_id || 0; + +# validate the notify method the user chose, if any. +# we can't do this in BEGIN, because it may not be instantiated yet, +# and we have to do it after loading modules because it might be in one. +@notifytypes = (); +if (length($notifytype) && $notifytype ne '0' && + $notifytype ne '1' && !$status) { + # NOT $script! scripts have a use case for notifiers! + + %dupenet = (); + foreach $nt (split(/\s*,\s*/, $notifytype)) { + $fnt="notifier_${nt}"; + (warn("** duplicate notification $nt was ignored\n"), next) + if ($dupenet{$fnt}); + eval 'return &$fnt(undef)' || + die("** invalid notification framework $nt: $@\n"); + $dupenet{$fnt}=1; + } + @notifytypes = keys %dupenet; + $notifytype = join(',', @notifytypes); + # warning if someone didn't tell us what notifies they wanted. + warn "-- warning: you specified -notifytype, but no -notifies\n" + if (!$silent && !length($notifies)); +} + +# set up track tags +if (length($tquery) && $tquery ne '0') { + my $xtquery = &tracktags_tqueryurlify($tquery); + die("** custom tquery is over 140 length: $xtquery\n") + if (length($xtquery) > 139); + @trackstrings = ($xtquery); +} else { + &tracktags_makearray; +} + +# compile filter +exit(1) if (!&filter_compile); + +# compile lists +exit(1) if (!&list_compile); + +# finally, compile notifies. we do this regardless of notifytype, so that +# an extension can look at it if it wants to. +¬ify_compile; + +# check that we are using a sensible authtype, based on our guessed user agent +$authtype ||= "oauth"; +die("** supported authtypes are basic, oauth and xauth only.\n") +if ($authtype ne 'basic' && $authtype ne 'xauth' && $authtype ne 'oauth'); +if ($authtype eq 'xauth' && !$anonymous) { + if (!$ssl && $apibase !~ /^https/i) { + print $stdout +"** xAuth requires -ssl. specifying this for you, or use -authtype=basic.\n"; + $ssl = 1; + } +} + +if ($termrl) { + $streamout = $stdout; # this is just simpler instead of dupping + warn(<<"EOF") if ($] < 5.006); +*********************************************************** +** -readline may not function correctly on Perls < 5.6.0 ** +*********************************************************** +EOF + print $stdout "-- readline using ".$termrl->ReadLine."\n"; +} else { + # dup $stdout for benefit of various other scripts + open(DUPSTDOUT, ">&STDOUT") || + warn("** warning: could not dup $stdout: $!\n"); + binmode(DUPSTDOUT, ":utf8") unless ($seven); + $streamout = \*DUPSTDOUT; +} +if ($silent) { + close($stdout); + open($stdout, ">>/dev/null"); # KLUUUUUUUDGE +} + +# after this point, die() may cause problems + +# initialize our route back out so background can talk to foreground +pipe(W, P) || die("pipe() error [or your Perl doesn't support it]: $!\n"); +select(P); $|++; +binmode(P, ":utf8") unless ($seven); +binmode(W, ":utf8") unless ($seven); + +# default command line options + +$anonymous ||= 0; +undef $user if ($anonymous); +print $stdout "-- using SSL for default URLs.\n" if ($ssl); +$http_proto = ($ssl) ? 'https' : 'http'; + +$lat ||= undef; +$long ||= undef; +$location ||= 0; +$linelength ||= 140; +$oauthbase ||= $apibase || "${http_proto}://api.twitter.com"; +# this needs to be AFTER oauthbase so that apibase can set oauthbase. +$apibase ||= "${http_proto}://api.twitter.com/1"; +$nonewrts ||= 0; +# special case: if we explicitly refuse backload, don't load initially. +$backload = 30 if (!defined($backload)); # zero is valid! +$dont_refresh_first_time = 1 if (!$backload); +$searchhits ||= 20; +$url ||= ($anonymous) + ? "${apibase}/statuses/public_timeline.json" + : ($nonewrts) + ? "${apibase}/statuses/friends_timeline.json" + : "${apibase}/statuses/home_timeline.json"; + +$oauthurl ||= "${oauthbase}/oauth/request_token"; +$oauthauthurl ||= "${oauthbase}/oauth/authorize"; +$oauthaccurl ||= "${oauthbase}/oauth/access_token"; +$xauthurl ||= $oauthaccurl; + +$credurl ||= "${apibase}/account/verify_credentials.json"; +$update ||= "${apibase}/statuses/update.json"; +$rurl ||= "${apibase}/statuses/mentions.json"; +$uurl ||= "${apibase}/statuses/user_timeline.json"; +$idurl ||= "${apibase}/statuses/show"; +$delurl ||= "${apibase}/statuses/destroy"; + +$rturl ||= "${apibase}/statuses/retweet"; +$rtsbyurl ||= "${apibase}/statuses/%I/retweeted_by.json"; +$rtsofmeurl ||= "${apibase}/statuses/retweets_of_me.json"; + +$wurl ||= "${apibase}/users/show.json"; + +$frurl ||= "${apibase}/friendships/exists.json"; +$followurl ||= "${apibase}/friendships/create"; +$leaveurl ||= "${apibase}/friendships/destroy"; +$blockurl ||= "${apibase}/blocks/create.json"; +$blockdelurl ||= "${apibase}/blocks/destroy.json"; +$friendsurl ||= "${apibase}/statuses/friends.json"; +$followersurl ||= "${apibase}/statuses/followers.json"; + +$rlurl ||= "${apibase}/account/rate_limit_status.json"; + +$dmurl ||= "${apibase}/direct_messages.json"; +$dmsenturl ||= "${apibase}/direct_messages/sent.json"; +$dmupdate ||= "${apibase}/direct_messages/new.json"; +$dmdelurl ||= "${apibase}/direct_messages/destroy"; +$dmidurl ||= "${apibase}/direct_messages/show"; + +$favsurl ||= "${apibase}/favorites"; +$myfavsurl ||= "${apibase}/favorites.json"; +$favurl ||= "${apibase}/favorites/create"; +$favdelurl ||= "${apibase}/favorites/destroy"; + +$modifyliurl ||= "${apibase}/%U/lists/%L.json"; # also for DELETE +$adduliurl ||= "${apibase}/%U/%L/members/create_all.json"; +$getliurl ||= "${apibase}/%U/%L/members.json"; # also for DELETE +$getlisurl ||= "${apibase}/%U/lists.json"; # also for POST and DELETE +$getuliurl ||= "${apibase}/%U/lists/memberships.json"; +$getufliurl ||= "${apibase}/%U/lists/subscriptions.json"; # POST and DELETE too +$getfliurl ||= "${apibase}/%U/%L/subscribers.json"; # POST and DELETE too +$statusliurl ||= "${apibase}/%U/lists/%L/statuses.json"; + +$queryurl ||= "http://search.twitter.com/search.json"; +$trendurl ||= "http://api.twitter.com/1/trends/daily.json"; + +# pick ONE! +#$shorturl ||= "http://api.tr.im/v1/trim_simple?url="; +$shorturl ||= "http://is.gd/api.php?longurl="; + +# figure out the domain to stop shortener loops +&generate_shortdomain; + +$pause = (($anonymous) ? 120 : "auto") if (!defined $pause); + # NOT ||= ... zero is a VALID value! +$superverbose ||= 0; +$avatar ||= ""; +$urlopen ||= 'echo %U'; +$hold ||= 0; +$daemon ||= 0; +$maxhist ||= 19; +undef $shadow_history; +$timestamp ||= 0; +$noprompt ||= 0; +$slowpost ||= 0; +$twarg ||= undef; + +$verbose ||= $superverbose; +$dmpause = 4 if (!defined $dmpause); # NOT ||= ... zero is a VALID value! +$dmpause = 0 if ($anonymous); +$dmpause = 0 if ($pause eq '0'); +$ansi = ($noansi) ? 0 : + (($ansi || $ENV{'TERM'} eq 'ansi' || $ENV{'TERM'} eq 'xterm-color') + ? 1 : 0); + +# synch overrides these options. +if ($synch) { + $pause = 0; + $dmpause = ($dmpause) ? 1 : 0; +} + +$dmcount = $dmpause; +$lastshort = undef; + +# ANSI sequences +$colourprompt ||= "CYAN"; +$colourme ||= "YELLOW"; +$colourdm ||= "GREEN"; +$colourreply ||= "RED"; +$colourwarn ||= "MAGENTA"; +$coloursearch ||= "CYAN"; +$colourlist ||= "OFF"; +$colourdefault ||= "OFF"; +$ESC = pack("C", 27); +$BEL = pack("C", 7); +&generate_ansi; + +# to force unambiguous bareword interpretation +$true = 'true'; +sub true { return 'true'; } +$false = 'false'; +sub false { return 'false'; } +$null = undef; +sub null { return undef; } + +select($stdout); $|++; + +# figure out what our user agent should be +if ($lynx) { + if (length($lynx) > 1 && -x "/$lynx") { + $wend = $lynx; + print $stdout "Lynx forced to $wend\n"; + } else { + $wend = &wherecheck("trying to find Lynx", "lynx", +"specify -curl to use curl instead, or just let TTYtter autodetect stuff.\n"); + } +} else { + if (length($curl) > 1 && -x "/$curl") { + $wend = $curl; + print $stdout "cURL forced to $wend\n"; + } else { + $wend = (($curl) ? &wherecheck("trying to find cURL", "curl", +"specify -lynx to use Lynx instead, or just let TTYtter autodetect stuff.\n") + : &wherecheck("trying to find cURL", "curl")); + if (!$curl && !length($wend)) { + $wend = &wherecheck("failed. trying to find Lynx", + "lynx", + "you must have either Lynx or cURL installed to use TTYtter.\n") + if (!length($wend)); + $lynx = 1; + } else { + $curl = 1; + } + } +} +$baseagent = $wend; + +# whoops, no Lynx here if we are not using Basic Auth + die( +"sorry, OAuth and xAuth are not currently supported with Lynx.\n". +"you must use SSL cURL, or specify -authtype=basic.\n") + if ($lynx && $authtype ne 'basic' && !$anonymous); + +# create and cache the logic for our selected user agent +if ($lynx) { + $simple_agent = "$baseagent -nostatus -source"; + + @wend = ('-nostatus'); + @wind = (@wend, '-source'); # GET agent + @wend = (@wend, '-post_data'); # POST agent + # we don't need to have the request signed by Lynx right now; + # it doesn't know how to pass custom headers. so this is simpler. + $stringify_args = sub { + my $basecom = shift; + my $resource = shift; + my $data = shift; + my $dont_do_auth = shift; + my $k = join("\n", @_); + + # if resource is an arrayref, then it's a GET with URL + # and args (mostly generated by &grabjson) + $resource = join('?', @{ $resource }) + if (ref($resource) eq 'ARRAY'); + die("wow, we have a bug: Lynx only works with Basic Auth\n") + if ($authtype ne 'basic' && !$dont_do_auth); + $k = "-auth=".$mytoken.':'.$mytokensecret."\n".$k + unless ($dont_do_auth); + $k .= "\n"; + $basecom = "$basecom \"$resource\" -"; + return ($basecom, $k, $data); + }; +} else { + $simple_agent = "$baseagent -s -m 20"; + + @wend = ('-s', '-m', '20', '-H', 'Expect:'); + @wind = @wend; + $stringify_args = sub { + my $basecom = shift; + my $resource = shift; + my $data = shift; + my $dont_do_auth = shift; + my $p; + my $l = ''; + + foreach $p (@_) { + if ($p =~ /^-/) { + $l .= "\n" if (length($l)); + $l .= "$p "; + next; + } + $l .= $p; + } + $l .= "\n"; + + # sign our request (Basic Auth or oAuth) + unless ($dont_do_auth) { + if ($authtype eq 'basic') { + $l .= "-u ".$mytoken.":".$mytokensecret."\n"; + } else { + my $nonce; + my $timestamp; + my $sig; + my $verifier = ''; + my $header; + my $ttoken = (length($mytoken) ? + (' oauth_token=\\"'.$mytoken.'\\",') : + ''); + + ($timestamp, $nonce, $sig, $verifier) = + &signrequest($resource, $data); + $header = <<"EOF"; +-H "Authorization: OAuth oauth_nonce=\\"$nonce\\", oauth_signature_method=\\"HMAC-SHA1\\", oauth_timestamp=\\"$timestamp\\", oauth_consumer_key=\\"$oauthkey\\", oauth_signature=\\"$sig\\",${ttoken}${verifier} oauth_version=\\"1.0\\"" +EOF + print $stdout $header if ($superverbose); + $l .= $header; + } + } + + # if resource is an arrayref, then it's a GET with URL + # and args (mostly generated by &grabjson) + $resource = join('?', @{ $resource }) + if (ref($resource) eq 'ARRAY'); + $l .= "url = \"$resource\"\n"; + $l .= "data = \"$data\"\n" if length($data); + return ("$basecom -K -", $l, undef); + }; +} + +# update check +if ($vcheck && !length($status)) { + $vs = &updatecheck(0); +} else { + $vs = +"-- no version check performed (use /vcheck, or -vcheck to check on startup)\n" + unless ($script || $status); +} +print $stdout $vs; # and then again when client starts up + +## make sure we have all the authentication pieces we need for the +## chosen method (authtoken handles this for Basic Auth and xAuth; +## this is where we validate OAuth) + +# if we use OAuth, then don't use any Basic Auth credentials we gave +# unless we specifically say -authtype=basic or xauth +if ($authtype eq 'oauth' && length($user)) { + print "** warning: -user is ignored when -authtype=oauth (default)\n"; + $user = undef; +} +$whoami = (split(/\:/, $user, 2))[0] unless ($anonymous || !length($user)); + +# yes, this is plaintext. obfuscation would be ludicrously easy to crack, +# and there is no way to hide them effectively or fully in a Perl script. +# so be a good neighbour and leave this the fark alone, okay? stealing +# credentials is mean and inconvenient to users. this is blessed by +# arrangement with Twitter. don't be a d*ck. thanks for your cooperation. +$oauthkey = (!length($oauthkey) || $oauthkey eq 'X') ? + "XtbRXaQpPdfssFwdUmeYw" : $oauthkey; +$oauthsecret = (!length($oauthsecret) || $oauthsecret eq 'X') ? + "csmjfTQPE8ZZ5wWuzgPJPOBR9dyvOBEtHT5cJeVVmAA" : $oauthsecret; + +unless ($anonymous) { +# if we are using Basic Auth or xAuth, ignore any user token we may have in +# our keyfile +if ($authtype eq 'basic' || $authtype eq 'xauth') { + $tokenkey = undef; + $tokensecret = undef; +} +# but if we are using OAuth, we can request one, unless we are in script +elsif ($authtype eq 'oauth' && (!length($keyf) || $oauthwizard)) { + if (length($oauthkey) && length($oauthsecret) && + !length($tokenkey) && !length($tokensecret)) { + # we have a key, we don't have the user token + # but we can't get that with -script + if ($script) { + print $streamout <<"EOF"; +AUTHENTICATION FAILURE +YOU NEED TO GET AN OAuth KEY, or use -authtype=basic +(run TTYtter without -script or -runcommand for help) +EOF + exit; + } + # run the wizard, which writes a keyfile for us + $keyf ||= $attempted_keyf; + print $stdout <<"EOF"; + ++----------------------------------------------------------------------------+ +|| WELCOME TO TTYtter: Authorize TTYtter by signing into Twitter with OAuth || ++----------------------------------------------------------------------------+ +Looks like you're starting TTYtter for the first time, and/or creating a +keyfile. Welcome to the most user-hostile, highly obfuscated, spaghetti code +infested and obscenely obscure Twitter client that's out there. You'll love it. + +TTYtter generates a keyfile that contains credentials for you, including your +access tokens. This needs to be done JUST ONCE. You can take this keyfile with +you to other systems. If you revoke TTYtter's access, you must remove the +keyfile and start again with a new token. You need to do this once per account +you use with TTYtter; only one account token can be stored per keyfile. If you +have multiple accounts, use -keyf=... to specify different keyfiles. KEEP THESE +FILES SECRET. + +** This wizard will overwrite $keyf +Press RETURN/ENTER to continue or CTRL-C NOW! to abort. +EOF + $j = <STDIN>; + print $stdout "\nRequest from $oauthurl ..."; + ($tokenkey, $tokensecret) = &tryhardfortoken($oauthurl, + "oauth_callback=oob"); + $mytoken = $tokenkey; + $mytokensecret = $tokensecret; # needs to be in both places + # kludge in case user does not specify SSL and this is + # Twitter: we know Twitter supports SSL + ($oauthauthurl =~ /twitter/) && + ($oauthauthurl =~ s/^http:/https:/); + print $stdout <<"EOF"; + +1. Visit, in your browser, ALL ON ONE LINE, + +${oauthauthurl}?oauth_token=$mytoken + +2. If you are not already signed in, fill in your username and password. + +3. Verify that TTYtter is the requesting application, and that its permissions +are as you expect (read your timeline, see who you follow and follow new +people, update your profile, post tweets on your behalf and access your +direct messages). IF THIS IS NOT CORRECT, PRESS CTRL-C NOW! + +4. Click Authorize app. + +5. A PIN will appear. Enter it below. + +EOF + $j = ''; + while(!(0+$j)) { + print $stdout "Enter PIN> "; + chomp($j = <STDIN>); + } + print $stdout "\nRequest from $oauthaccurl ..."; + ($tokenkey, $tokensecret) = &tryhardfortoken($oauthaccurl, + "oauth_verifier=$j"); + + $oauthkey = "X"; + $oauthsecret = "X"; + open(W, ">$keyf") || + die("Failed to write keyfile $keyf: $!\n"); + print W <<"EOF"; +ck=${oauthkey}&cs=${oauthsecret}&at=${tokenkey}&ats=${tokensecret} +EOF + close(W); + chmod(0600, $keyf) || print $stdout + "Warning: could not change permissions on $keyf : $!\n"; + print $stdout <<"EOF"; +Written keyfile $keyf + +Now, restart TTYtter to use this keyfile. +(To choose between multiple keyfiles other than the default .ttytterkey, + tell TTYtter where the key is using -keyf=... .) + +EOF + exit; + } + # if we get three of the four, this must have been command line + if (length($oauthkey) && length($oauthsecret) && + (!length($tokenkey) || !length($tokensecret))) { + my $error = undef; + my $k; + foreach $k (qw(oauthkey oauthsecret tokenkey tokensecret)) { + $error .= "** you need to specify -$k\n" + if (!length($$k)); + } + if (length($error)) { + print $streamout <<"EOF"; + +you are missing portions of the OAuth sequence. either create a keyfile +and point to it with -keyf=... or add these missing pieces: +$error +then restart TTYtter, or use -authtype=basic, or =xauth for supported keys. +EOF + exit; + } + } +} elsif ($retoke && length($keyf)) { + # start the "re-toke" wizard to convert DM-less cloned app keys. + # dup STDIN for systems that can only "close" it once + open(STDIN2, "<&STDIN") || die("couldn't dup STDIN: $!\n"); + print $stdout <<"EOF"; + ++-------------------------------------------------------------------------+ +|| The Re-Toke Wizard: Generate a new TTYtter keyfile for your app/token || ++-------------------------------------------------------------------------+ +Twitter is requiring tokens to now have specific permissions to READ +direct messages. This will be enforced by 1 July 2011. If you find you are +unable to READ direct messages, you will need this wizard. DO NOT use this +wizard if you are NOT using a cloned app key (1.2 and on) -- use -oauthwizard. + +This wizard will create a new keyfile for you from your app/user keys/tokens. +You do NOT need this wizard if you are using TTYtter for a purpose that does +not require direct message access. For example, if TTYtter is acting as +your command line posting agent, or you are only using it to read your +timeline, you do NOT need a new token. You also do not need a new token to +SEND a direct message, only to READ ones this account has received. + +You SHOULD NOT need this wizard if your app key was cloned after 1 June 2011. +However, you can still use it if you experience this specific issue with DMs, +or need to rebuild your keyfile for any other reason. + +** This wizard will overwrite the key at $keyf +** To change this, restart TTYtter with -retoke -keyf=/path/to/keyfile +Press RETURN/ENTER to continue, or CTRL-C NOW! to abort. +EOF + + $j = <STDIN>; + print $stdout <<"EOF"; + +First: let's get your API key, consumer key and consumer secret. +Start your browser. +1. Log into https://twitter.com/ with your desired account. +2. Go to this URL. You must be logged into Twitter FIRST! + +https://dev.twitter.com/apps + +3. Click the TTYtter cloned app key you need to regenerate or upgrade. +4. Click Edit Application Settings. +5. Make sure Read, Write & Private Message is selected, and click the + "Save application" button. +6. Select All (CTRL/Command-A) on the next screen, copy (CTRL/Command-C) it, + and paste (CTRL/Command-V) it into this window. (You can also cut and + paste a smaller section if I can't understand your browser's layout.) +7. Press ENTER/RETURN and CTRL-D when you have pasted the window contents. +EOF + + $q = $/; + PASTE1LOOP: for(;;) { + print $stdout <<"EOF"; + +-- Press ENTER and CTRL-D AFTER you have pasted the window contents! --------- +Go ahead: +EOF + undef $/; + $j = <STDIN2>; + print $stdout <<"EOF"; + +-- EOF ----------------------------------------------------------------------- +Processing ... + +EOF + $j =~ s/[\r\n]/ /sg; + + # process this. as a checksum, API key should == consumer key. + $ak = ''; + $ck = ''; + $cs = ''; + ($j =~ /API key\s+([-a-zA-Z0-9_]{10,})\s+/) && ($ak = $1); + ($j =~ /Consumer key\s+([-a-zA-Z0-9_]{10,})\s+/) && ($ck = $1); + ($j =~ /Consumer secret\s+([-a-zA-Z0-9_]{10,})\s+/) && + ($cs = $1); + + if (!length($ak) || !length($ck) || !length($cs)) { + # escape hatch + print $stdout <<"EOF"; +Something's wrong: I could not find your API key, consumer key or consumer +secret in that text. If this was a misfired paste, please restart the wizard. +Otherwise, bug me at \@ttytter or ckaiser\@floodgap.com. Please don't send +keys or secrets to either address. + +EOF + exit; + } + if ($ak ne $ck) { + print $stdout <<"EOF"; +Your API key "$ak" doesn't match your consumer key "$ck". +Please try again, or just hit CTRL-C to cancel if you're stuck. +EOF + next PASTE1LOOP; + } + last PASTE1LOOP; + } + # this part is similar to the retoke. + $oauthkey = $ck; + $oauthsecret = $cs; + print $stdout "\nI'm testing this key to see if it works.\n"; + print $stdout "Request from $oauthurl ..."; + ($tokenkey, $tokensecret) = &tryhardfortoken($oauthurl, + "oauth_callback=oob"); + $mytoken = $tokenkey; + $mytokensecret = $tokensecret; + # kludge in case user does not specify SSL and this is + # Twitter: we know Twitter supports SSL + ($oauthauthurl =~ /twitter/) && ($oauthauthurl =~ s/^http:/https:/); + $/ = $q; + print $stdout <<"EOF"; + +Okay, your consumer key is ==> $ck + and your consumer secret ==> $cs + +IF THIS IS WRONG, PRESS CTRL-C NOW AND RESTART THE WIZARD! + +Now we will verify your Imperial battle station is fully operational by +signing in with OAuth. + +1. Visit, in your browser, ALL ON ONE LINE (you should still be logged in), + +${oauthauthurl}?oauth_token=$mytoken + +2. Verify that your app is the requesting application, and that its permissions +are as you expect (read your timeline, see who you follow and follow new +people, update your profile, post tweets on your behalf and access your +direct messages). IF THIS IS NOT CORRECT, PRESS CTRL-C NOW! + +3. Click Authorize app. + +4. A PIN will appear. Enter it below. + +EOF + print $stdout "Enter PIN> "; + chomp($j = <STDIN>); + print $stdout "\nRequest from $oauthaccurl ..."; + ($at, $ats) = &tryhardfortoken($oauthaccurl, "oauth_verifier=$j"); + + print $stdout <<"EOF"; + +Consumer key =========> $ck +Consumer secret ======> $cs +Access token =========> $at +Access token secret ==> $ats + +EOF + open(W, ">$keyf") || (print $stdout ("Unable to write to $keyf: $!\n"), + exit); + print W "ck=$ck&cs=$cs&at=$at&ats=$ats\n"; + close(W); + chmod(0600, $keyf) || print $stdout +"Warning: could not change permissions on $keyf : $!\n"; + print $stdout "Keys written to regenerated keyfile $keyf\n"; + print $stdout "Now restart TTYtter.\n"; + exit; +} + +# now, get a token (either from Basic Auth, the keyfile, OAuth, or xAuth) +($mytoken, $mytokensecret) = &authtoken; +} # unless anonymous + +# initial login tests and command line controls +if ($statusurl) { + $shorstatusturl = &urlshorten($statusurl); + $status = ((length($status)) ? "$status " : "") . $shorstatusturl; +} +$phase = 0; +$didhold = $hold; +$hold = -1 if ($hold == 1 && !$script); +$credentials = ''; +$status = pack("U0C*", unpack("C*", $status)) + unless ($seven || !length($status) || $LANG =~ /8859/); # kludgy also +chomp($status = <STDIN>) if ($status eq '-' && !$oldstatus); +for(;;) { + $rv = 0; + die( + "sorry, you can't tweet anonymously. use an authenticated username.\n") + if ($anonymous && length($status)); + die( +"sorry, status too long: reduce by @{[ length($status)-$linelength ]} chars, ". +"or use -autosplit={word,char,cut}.\n") + if (length($status) > $linelength && !$autosplit); + ($status, $next) = &csplit($status, ($autosplit eq 'char' || + $autosplit eq 'cut') ? 1 : 0) + if (!length($next)); + if ($autosplit eq 'cut' && length($next)) { + print "-- warning: input autotrimmed to $linelength bytes\n"; + $next = ""; + } + if (!$anonymous && !length($whoami) && !length($status)) { + # we must be using OAuth tokens without xAuth. we'll need + # to get our screen name from Twitter. we DON'T need this + # if we're just posting with -status. + print "(checking credentials) "; $data = + $credentials = &backticks($baseagent, '/dev/null', undef, + $credurl, undef, $anonymous, @wind); + $rv = $? || &is_fail_whale($data) || &is_json_error($data); + } + if (!$rv && length($status) && $phase) { + print "post attempt "; $rv = &updatest($status, 0); + } else { + unless ($rv) { + print "test-login "; + $data = &backticks($baseagent, '/dev/null', undef, + $url, undef, $anonymous, @wind); + $rv = $?; + } + } + if ($rv || &is_fail_whale($data) || &is_json_error($data)) { + if (&is_fail_whale($data)) { + print "FAILED -- Fail Whale detected\n"; + } elsif ($x = &is_json_error($data)) { + print "FAILED!\n*** server reports: \"$x\"\n"; + print "check your password or configuration.\n"; + } else { + $x = $rv >> 8; + print + "FAILED. ($x) bad password, login or URL? server down?\n"; + } + print "access failure on: "; + print (($phase) ? $update : $url); + print "\n"; + print + "--- data received ($hold) ---\n$data\n--- data received ($hold) ---\n" + if ($superverbose); + if ($hold && --$hold) { + print + "trying again in 1 minute, or kill process now.\n\n"; + sleep 60; + next; + } + if ($didhold) { + print "giving up after $didhold tries.\n"; + } else { + print + "to automatically wait for a connect, use -hold.\n"; + } + exit(1); + } + if ($status && !$phase) { + print "SUCCEEDED!\n"; + $phase++; + next; + } + if (length($next)) { + print "SUCCEEDED!\n(autosplit) "; + $status = $next; + $next = ""; + next; + } + last; +} +print "SUCCEEDED!\n"; +exit(0) if (length($status)); +$SIG{'USR1'} = sub { ; }; +if (length($credentials)) { + print "-- processing credentials: "; + $my_json_ref = &parsejson($credentials); + $whoami = $my_json_ref->{'screen_name'}; + if (!length($whoami)) { + print "FAILED!\nis your account suspended, or wrong token?\n"; + exit; + } + print "logged in as $whoami\n"; + $credlog = "-- you are logged in as $whoami\n"; +} + +#### BOT/DAEMON MODE STARTUP #### + +$last_rate_limit = undef; +$rate_limit_left = undef; +$rate_limit_rate = undef; +$rate_limit_next = 0; +$effpause = 0; # for both daemon and background +if ($daemon) { + if (!$pause) { + print $stdout "*** kind of stupid to run daemon with pause=0\n"; + exit 1; + } + if ($child = fork()) { + print $stdout "*** detached daemon released. pid = $child\n"; + kill 15, $$; + exit 0; + } elsif (!defined($child)) { + print $stdout "*** fork() failed: $!\n"; + exit 1; + } else { + # using our regular MONITOR select() loop won't work, because + # STDIN is almost always "ready." so we use a blunter, + # simpler one. + $parent = 0; + $dmcount = 1 if ($dmpause); # force fetch + $is_background = 1; + for(;;) { + &$heartbeat; + &update_effpause; + if ($dont_refresh_first_time) { + $dont_refresh_first_time = 0; + } else { + &refresh(0); + } + if ($dmpause) { + if (!--$dmcount) { + &dmrefresh(0); + $dmcount = $dmpause; + } + } + sleep ($effpause || 0+$pause || 60); + } + } + die("uncaught fork() exception\n"); +} + +#### INTERACTIVE MODE and CONSOLE STARTUP #### + +unless ($simplestart) { + print <<"EOF"; + +###################################################### +oo=========oo+ + ${EM}TTYtter ${TTYtter_VERSION}.${padded_patch_version} (c)2011 cameron kaiser${OFF} @ @ +EOF + $e = <<'EOF'; + ${EM}all rights reserved.${OFF} +oo= =====oo+ + ${EM}http://www.floodgap.com/software/ttytter/${OFF} ${GREEN}a==:${OFF} ooo + ${GREEN}.++o++.${OFF} ${GREEN}..o**O${OFF} + freeware under the floodgap free software license. ${GREEN}+++${OFF} :O${GREEN}:::::${OFF} + http://www.floodgap.com/software/ffsl/ ${GREEN}+**O++${OFF} # ${GREEN}:ooa${OFF} + #+$$AB=. + ${EM}tweet me: http://twitter.com/ttytter${OFF} #;;${YELLOW}ooo${OFF};; + ${EM}tell me: ckaiser@floodgap.com${OFF} #+a;+++;O +###################################################### ,$B.${RED}*o***${OFF} O$, +# a=o${RED}$*O*O*$${OFF}o=a +# when ready, hit RETURN/ENTER for a prompt. @${RED}$$$$$${OFF}@ +# type /help for commands or /quit to quit. @${RED}o${OFF}@o@${RED}o${OFF}@ +# starting background monitoring process. @=@ @=@ +# +EOF + $e =~ s/\$\{([A-Z]+)\}/${$1}/eg; print $stdout $e; +} else { + print <<"EOF"; +TTYtter ${TTYtter_VERSION}.${padded_patch_version} (c)2011 cameron kaiser +all rights reserved. freeware under the floodgap free software license. +http://www.floodgap.com/software/ffsl/ + +tweet me: http://twitter.com/ttytter * tell me: ckaiser\@floodgap.com +type /help for commands or /quit to quit. +starting background monitoring process. + +EOF +} +if ($superverbose) { + print $stdout "-- OMGSUPERVERBOSITYSPAM enabled.\n\n"; +} else { + print $stdout "-- verbosity enabled.\n\n" if ($verbose); +} +sleep 3 unless ($silent); + +# these three functions are outside of the usual API assertions for clarity. +# they represent the main loop, which by default is the interactive console. +# the main loop can be redefined. + +sub defaultprompt { + my $rv = ($noprompt) ? "" : "TTYtter> "; + my $rvl = ($noprompt) ? 0 : 9; + return ($rv, $rvl) if (shift); + $wrapseq = 0; + print $stdout "${CCprompt}$rv${OFF}" unless ($termrl); +} +sub defaultaddaction { return 0; } +sub defaultmain { + if (length($runcommand)) { + &prinput($runcommand); + &sync_n_quit; + } + @history = (); + print C "rsga---------------\n"; + $dont_use_counter = $nocounter; + eval '$termrl->hook_no_counter'; + if ($termrl) { + while(defined ($_ = $termrl->readline((&$prompt(1))[0]))) { + kill 30, $child; # suppress output + $rv = &prinput($_); + kill 31, $child; # resume output + last if ($rv < 0); + &sync_console unless (!$rv || !$synch); + if ($dont_use_counter ne $nocounter) { + # only if we have to -- this is expensive + $dont_use_counter = $nocounter; + eval '$termrl->hook_no_counter' + } + } + } else { + &$prompt; + while(<>) { #not stdin so we can read from script files + kill 30, $child; # suppress output + $rv = &prinput(&uforcemulti($_)); + kill 31, $child; # resume output + last if ($rv < 0); + &sync_console unless (!$rv || !$synch); + &$prompt; + } + &sync_n_quit if ($script); + } +} + +$SIG{'PIPE'} = $SIG{'BREAK'} = $SIG{'INT'} = \&end_me; +$SIG{'USR1'} = $SIG{'PWR'} = $SIG{'XCPU'} = \&repaint; +sub send_repaint { + unless ($wrapseq){ + return; + } + $wrapseq = 0; + return if ($daemon); + if ($child) { + # we are the parent, call our repaint + &repaint; + } else { + # we are not the parent, call the parent to repaint itself + kill 30, $parent; # send SIGUSR1 + } +} +sub repaint { + # try to speed this up, since we do it a lot. + $wrapseq = 0; + return &$repaintcache if ($repaintcache) ; + + # cache our repaint function (no-op or redisplay) + $repaintcache = sub { ; }; # no-op + return unless ($termrl && + ($termrl->Features()->{'canRepaint'} || $readlinerepaint)); + return if ($daemon); + $termrl->redisplay; $repaintcache = sub { $termrl->redisplay; }; +} +sub send_removereadline { + # this just stubs into its own removereadline + return &$removereadlinecache if ($removereadlinecache); + + $removereadlinecache = sub { ; }; + return unless ($termrl && $termrl->Features()->{'canRemoveReadline'}); + return if ($daemon); + $termrl->removereadline; + $removereadlinecache = sub { $termrl->removereadline; }; +} + +# start the background process +# this has to be last or the background process can't see the full API +if ($child = open(C, "|-")) { + close(P); + binmode(C, ":utf8") unless ($seven); +} else { + close(W); + goto MONITOR; +} +eval'$termrl->hook_background_control' if ($termrl); +select(C); $|++; select($stdout); + +# handshake for synchronicity mode, if we want it. +if ($synch) { + # we will get two replies for this. + print C "synm---------------\n"; + &thump; + # the second will be cleared by the console +} + +# start the +&$main; +# loop until we quit and then we'll +&sync_n_quit if ($script); +# else +exit; + +#### command processor #### + +sub prinput { + my $i; + local($_) = shift; # bleh + + # validate this string if we are in UTF-8 mode + unless ($seven) { + $probe = $_; + &$utf8_encode($probe); + die("utf8 doesn't work right in this perl. run with -seven.\n") + if (&ulength($probe) < length($_)); + # should be at least as big + if ($probe =~ /($badutf8)/) { +print $stdout "*** invalid UTF-8: partial delete of a wide character?\n"; + print $stdout "*** ignoring this string\n"; + return 0; + } + } + + $in_reply_to = 0; + chomp; + $_ = &$precommand($_); + s/^\s+//; + s/\s+$//; + my $cfc = 0; + $cfc++ while (s/\033\[[0-9]?[ABCD]// || s/.[\177]// || s/.[\010]// + || s/[\000-\037\177]//); + if ($cfc) { + $history[0] = $_; + print $stdout "*** filtered control characters; now \"$_\"\n"; + print $stdout "*** use %% for truncated version, or append to %%.\n"; + return 0; + } + + if (/^$/) { + return 1; + } + + if (!$slowpost && !$verify && # we assume you know what you're doing! + ($_ eq 'h' || $_ eq 'help' || $_ eq 'quit' || $_ eq 'q' || + /^TTYtter>/ || $_ eq 'ls' || $_ eq '?' || + m#^help /# || $_ eq 'exit')) { + + &add_history($_); + unless ($_ eq 'exit' || /^TTYtter>/ || $_ eq 'ls') { + print $stdout "*** did you mean /$_ ?\n"; + print $stdout + "*** to send this as a command, type /%%\n"; + } else { + print $stdout + "*** did you really mean to tweet \"$_\"?\n"; + } + print $stdout "*** to tweet it anyway, type %%\n"; + return 0; + } + + if (/^\%(\%|-\d+):p$/) { + my $x = $1; + if ($x eq '%') { + print $stdout "=> \"$history[0]\"\n"; + } else { + $x += 0; + if (!$x || $x < -(scalar(@history))) { + print $stdout "*** illegal index\n"; + } else { + print $stdout "=> \"$history[-($x + 1)]\"\n"; + } + } + return 0; + } + + # handle history substitution (including /%%, %%--, %%*, etc.) + $i = 0; # flag + + if (/^\%(\%|-\d+)(--|-\d+|\*)?/) { + ($i, $proband, $r, $s) = &sub_helper($1, $2, $_); + return 0 if (!$i); + + $s = quotemeta($s); + s/^\%${r}${s}/$proband/; + } + if (/[^\\]\%(\%|-\d+)(--|-\d+|\*)?$/) { + ($i, $proband, $r, $s) = &sub_helper($1, $2, $_); + return 0 if (!$i); + + $s = quotemeta($s); + s/\%${r}${s}$/$proband/; + } + # handle variables second, in case they got in history somehow ... + $i = 1 if (s/^\%URL\%/$urlshort/ || s/\%URL\%$/$urlshort/); + $i = 1 if (s/^\%RT\%/$retweet/ || s/\%RT\%$/$retweet/); + + # and escaped history + s/^\\\%/%/; + + if ($i) { + print $stdout "(expanded to \"$_\")\n" ; + $in_reply_to = $expected_tweet_ref->{'id_str'} || 0 + if (defined $expected_tweet_ref && + ref($expected_tweet_ref) eq 'HASH'); + } else { + $expected_tweet_ref = undef; + } + + return 0 unless length; # actually possible to happen + # with control char filters and history. + + &add_history($_); + $shadow_history = $_; + + # handle history display + if ($_ eq '/history' || $_ eq '/h') { + for ($i = scalar(@history); $i >= 1; $i--) { + print $stdout "\t$i\t$history[($i-1)]\n"; + } + return 0; + } + + my $slash_first = ($_ =~ m#^/#); + + return -1 if ($_ eq '/quit' || $_ eq '/q' || $_ eq '/bye' || + $_ eq '/exit'); + + return 0 if (scalar(&$addaction($_))); + + # add commands here + + if (m#^/du(mp)? ([zZ]?[a-zA-Z][0-9])$#) { + my $code = lc($2); + my $tweet = &get_tweet($code); + my $k; + my $sn; + my $id; + my @superfields = ( + [ "user", "screen_name" ], # must always be first + [ "retweeted_status", "id_str" ], + [ "user", "geo_enabled" ], + [ "tag", "type" ], + [ "tag", "payload" ], + ); + my $superfield; + + if (!defined($tweet)) { + print $stdout "-- no such tweet (yet?): $code\n"; + return 0; + } + + foreach $superfield (@superfields) { + my $sfn = join('->', @{ $superfield }); + my $sfk = "{'" . join("'}->{'", @{ $superfield }) . + "'}"; + my $sfv; + eval "\$sfv = &descape(\$tweet->$sfk);"; + print $stdout + substr("$sfn ", 0, 25). + " $sfv\n"; + $sn = $sfv if (!length($sn) && length($sfv)); + } + # geo is special + print $stdout "geo->coordinates (" . + join(', ', @{ $tweet->{'geo'}->{'coordinates'} }) + . ")\n"; + foreach $k (sort keys %{ $tweet }) { + next if (ref($tweet->{$k})); + print $stdout + substr("$k ", 0, 25) . + " " . &descape($tweet->{$k}) . "\n"; + } + # include a URL to the tweet per @augmentedfourth + $urlshort = + "${http_proto}://twitter.com/$sn/statuses/$tweet->{'id_str'}"; + print $stdout + "-- %URL% is now $urlshort (/short to shorten)\n"; + return 0; + } + + # should we go get the DM from the server? maybe in the future. + if (m#^/du(mp)? ([dD][a-zA-Z][0-9])$#) { + my $code = lc($2); + my $dm = &get_dm($code); + my $k; + my $sn; + my $id; + my @superfields = ( + [ "sender", "screen_name" ], # must always be first + ); + + if (!defined($dm)) { + print $stdout "-- no such DM (yet?): $code\n"; + return 0; + } + + foreach $superfield (@superfields) { + my $sfn = join('->', @{ $superfield }); + my $sfk = "{'" . join("'}->{'", @{ $superfield }) . + "'}"; + my $sfv; + eval "\$sfv = &descape(\$dm->$sfk);"; + print $stdout + substr("$sfn ", 0, 25). + " $sfv\n"; + $sn = $sfv if (!length($sn) && length($sfv)); + } + + foreach $k (sort keys %{ $dm }) { + next if (ref($dm->{$k})); + print $stdout + substr("$k ", 0, 25) . + " " . &descape($dm->{$k}) . "\n"; + } + return 0; + } + + # evaluator + if (m#^/ev(al)? (.+)$#) { + $k = eval $2; + print $stdout "==> $k $@\n"; + return 0; + } + + # version check + if (m#^/v(ersion)?check$# || m#^/u(pdate)?check$#) { + print $stdout &updatecheck(1); + return 0; + } + + # url shortener routine + if (($_ eq '/sh' || $_ eq '/short') && length($urlshort)) { + $_ = "/short $urlshort"; + print $stdout "*** assuming you meant %URL%: $_\n"; + # and fall through to ... + } + if (m#^/sh(ort)? (https?|gopher)(://[^ ]+)#) { + my $url = $2 . $3; + my $answer = (&urlshorten($url) || 'FAILED -- %% to retry'); + print $stdout "*** shortened to: "; + print $streamout ($answer . "\n"); + return 0; + } + + # getter for internal value settings + if (/^\/r(ate)?l(imit)?$/) { + $_ = '/print rate_limit_rate'; + # and fall through to ... + } + + if ($_ eq '/p' || $_ eq '/print') { + foreach $key (sort keys %opts_can_set) { + print $stdout "*** $key => $$key\n" + if (!$opts_secret{$key}); + } + return 0; + } + if (/^\/p(rint)?\s+([^ ]+)/) { + my $key = $2; + if ($valid{$key} || + $key eq 'effpause' || + $key eq 'rate_limit_rate' || + $key eq 'rate_limit_left') { + my $value = &getvariable($key); + print $stdout "*** "; + print $stdout "(read-only value) " + if (!$opts_can_set{$key}); + print $stdout "$key => $value\n"; + + # I don't see a need for these in &getvariable, so they are + # not currently supported. whine if you disagree. + + } elsif ($key eq 'tabcomp') { + if ($termrl) { + &generate_otabcomp; + } else { + print $stdout "*** readline isn't on\n"; + } + } elsif ($key eq 'ntabcomp') { # sigh + if ($termrl) { + print $stdout "*** new TAB-comp entries: "; + $did_print = 0; + foreach(keys %readline_completion) { + next if ($original_readline{$_}); + $did_print = 1; + print $stdout "$_ "; + } + print $stdout "(none)" if (!$did_print); + print $stdout "\n"; + } else { + print $stdout "*** readline isn't on\n"; + } + + } else { + print "*** not a valid option or setting: $key\n"; + } + return 0; + } + if ($_ eq '/verbose' || $_ eq '/ve') { + $verbose ^= 1; + $_ = "/set verbose $verbose"; + print $stdout "-- verbosity.\n" if ($verbose); + # and fall through to set + } + + # search api integration (originally based on @kellyterryjones', + # @vielmetti's and @br3nda's patches) + if (/^\/se(arch)?\s+(\+\d+\s+)?(.+)\s*$/) { + my $countmaybe = $2; + my $kw = $3; + $countmaybe =~ s/[^\d]//g if (length($countmaybe)); + $countmaybe += 0; + $countmaybe ||= $searchhits; + $kw =~ s/([^ a-z0-9A-Z_])/&uhex($1)/eg; + $kw =~ s/\s+/+/g; + $kw = "q=$kw" if ($kw !~ /^q=/); + $kw .= "&rpp=$countmaybe"; + + my $r = &grabjson("$queryurl?$kw", 0, 1); + if (defined($r) && ref($r) eq 'ARRAY' && scalar(@{ $r })) { + &dt_tdisplay($r, 'search'); + } else { + print $stdout "-- sorry, no results were found.\n"; + } + &$conclude; + return 0; + } + if ($_ eq '/notrack') { # special case + print $stdout "*** all tracking keywords cancelled\n"; + $track = ''; + &setvariable('track', $track, 1); + return 0; + } + if (s/^\/troff\s+// && s/\s*// && length) { + # remove it from array, regenerate $track, call tracktags_makearray + # and then sync + my $k; + my $l = ''; + my $q = 0; + my %w; + my (@ptags) = split(/\s+/, $_); + + # filter duplicates and merge quoted strings (again) + # but this time we're building up a hash for fast searches + foreach $k (@ptags) { + if ($q && $k =~ /"$/) { # this has to be first + $l .= " $k"; + $q = 0; + } elsif ($k =~ /^"/ || $q) { + $l .= (length($l)) ? " $k" : $k; + $q = 1; + next; + } else { + $l = $k; + } + next if ($w{$l}); # ignore silently here + $w{$l} = 1; + $l = ''; + } + print $stdout "-- warning: syntax error, missing quote?\n" + if ($q); + + # now filter out of @tracktags + @ptags = (); + foreach $k (@tracktags) { + push (@ptags, $k) unless ($w{$k}); + } + unless (scalar(@ptags) < scalar(@tracktags)) { + print $stdout "-- sorry, no track terms matched.\n"; + print $stdout (length($track) ? + "-- you are tracking: $track\n" : + "-- (maybe because you're not tracking anything?)\n"); + return 0; + } + print $stdout "*** ok, filtered @{[ keys(%w) ]}\n"; + $track = join(' ', @ptags); + &setvariable('track', $track, 1); + return 0; + } + if ($_ eq '/tre' || $_ eq '/trends') { + my $t; + my $r = &grabjson("$trendurl", 0, 1); + +#{"as_of":1237580149,"trends":{"2009-03-20 20:15:49":[{"query":"#sxsw OR SXSW", + if (defined($r) && ref($r) eq 'HASH' && ($t = $r->{'trends'})){ + my $i; + my $j; + + print $stdout "${EM}<<< TRENDING TOPICS >>>${OFF}\n"; + # this is moderate paranoia + foreach $i (sort { $b cmp $a } keys %{ $t }) { + foreach $j (@{ $t->{$i} }) { + my $k = &descape($j->{'query'}); + my $l = ($k =~ /\sOR\s/) ? $k : + ($k =~ /^"/) ? $k : + ('"' . $k . '"'); + print $stdout "/search $l\n"; + $k =~ s/\sOR\s/ /g; + $k = '"' . $k . '"' if ($k =~ /\s/ + && $k !~ /^"/); + print $stdout "/tron $k\n"; + } + last; # emulate old trends/current behaviour + } + print $stdout "${EM}<<< TRENDING TOPICS >>>${OFF}\n"; + } else { + print $stdout "-- sorry, trends not available.\n"; + } + return 0; + } + + 1 if (s/^\/#([^\s]+)/\/tron #\1/); + # /# command falls through to tron + if (s/^\/tron\s+// && s/\s*$// && length) { + $track .= " " if (length($track)); + $_ = "/set track ${track}$_"; + # fall through to set + } + if (/^\/track ([^ ]+)/) { + s#^/#/set #; + # and fall through to set + } + + # /listoff + if (s/^\/list?off\s+// && s/\s*$// && length) { + if (/,/ || /\s+/) { + print $stdout "-- one list at a time please\n"; + return 0; + } + if (!scalar(@listlist)) { + print $stdout + "-- ok! that was easy! (you don't have any lists in your timeline)\n"; + return 0; + } + my $w; + my $newlists = ''; + my $didfilter = 0; + foreach $w (@listlist) { + my $x = join('/', @{ $w }); + if ($x eq $_ || "$whoami$_" eq $x || + "$whoami/$_" eq $x) { + print $stdout "*** ok, filtered $x\n"; + $didfilter = 1; + } else { + $newlists .= (length($newlists)) ? ",$x" + : $x; + } + } + if ($didfilter) { + &setvariable('lists', $newlists, 1); + } else { + print $stdout "*** hmm, no such list? current value:\n"; + print $stdout "*** lists => ", + &getvariable('lists'), "\n"; + } + return 0; + } + + # /liston + if (s/^\/list?on\s+// && s/\s*$// && length) { + if (/,/ || /\s+/) { + print $stdout "-- one list at a time please\n"; + return 0; + } + my $uname; + my $lname; + if (m#/#) { + ($uname, $lname) = split(m#/#, $_, 2); + } else { + $lname = $_; + $uname = ''; + } + if (!length($uname) && $anonymous) { + print $stdout +"-- you must specify a username for a list when anonymous.\n"; + return 0; + } + $uname ||= $whoami; + + # check the list validity + my $my_json_ref = + &grabjson(&liurltourl($statusliurl, $lname, $uname), + 0, 0, 0); + if (!$my_json_ref || ref($my_json_ref) ne 'ARRAY') { + print $stdout + "*** list $uname/$lname seems bogus; not added\n"; + return 0; + } + + $_ = "/add lists $uname/$lname"; + # fall through to add + } + if (s/^\/a(uto)?lists?\s+// && s/\s*$// && length) { + s/\s+/,/g if (!/,/); + print $stdout + "--- warning: lists aren't checked en masse; make sure they exist\n"; + $_ = "/set lists $_"; + # and fall through to set + } + + # setter for internal value settings + # shortcut for boolean settings + if (/^\/s(et)? ([^ ]+)\s*$/) { + my $key = $2; + $_ = "/set $key 1" + if($opts_boolean{$key} && $opts_can_set{$key}); + # fall through to three argument version + } + if (/^\/uns(et)? ([^ ]+)\s*$/) { + my $key = $2; + if ($opts_can_set{$key} && $opts_boolean{$key}) { + &setvariable($key, 0, 1); + return 0; + } + &setvariable($key, undef, 1); + return 0; + } + # stubs out to set variable + if (/^\/s(et)? ([^ ]+) (.+)\s*$/) { + my $key = $2; + my $value = $3; + &setvariable($key, $value, 1); + return 0; + } + # append to a variable (if not boolean) + if (/^\/ad(d)? ([^ ]+) (.+)\s*$/) { + my $key = $2; + my $value = $3; + if ($opts_boolean{$key}) { + print $stdout + "*** why are you appending to a boolean?\n"; + return 0; + } + if (length(&getvariable($key))) { + $value = " $value" if ($opts_space_delimit{$key}); + $value = ",$value" if ($opts_comma_delimit{$key}); + } + &setvariable($key, &getvariable($key).$value, 1); + return 0; + } + + # stackable settings + # shortcut for boolean settings (push only -- irrelevant for pad) + if (/^\/pu(sh)? ([^ ]+)\s*$/) { + my $key = $2; + $_ = "/push $key 1" + if($opts_boolean{$key} && $opts_can_set{$key}); + # fall through to three argument version + } + # common code for set and append + if (/^\/(pu|push|pad|padd) ([^ ]+) (.+)\s*$/) { + my $comm = $1; + my $key = $2; + my $value = $3; + $comm = ($comm =~ /^pu/) ? "push" : "padd"; + if ($opts_boolean{$key} && $comm eq 'padd') { + print $stdout + "*** why are you appending to a boolean?\n"; + return 0; + } + my $old = &getvariable($key); + if (!defined($old) || !$opts_can_set{$key}) { + print $stdout + "*** setting is not stackable: $key\n"; + return 0; + } + push(@{ $push_stack{$key} }, $old); + print $stdout "--- saved on stack for $key: $old\n"; + if ($comm eq 'padd' && length($old)) { + $value = " $value" if ($opts_space_delimit{$key}); + $value = ",$value" if ($opts_comma_delimit{$key}); + $old .= $value; + } else { + $old = $value; + } + &setvariable($key, $old, 1); + return 0; + } + # we assume that if the setting is in the push stack, it's valid + if (/^\/pop ([^ ]+)\s*$/) { + my $key = $1; + if (!scalar(@{ $push_stack{$key} })) { + print $stdout + "*** setting is not stacked: $key\n"; + return 0; + } + &setvariable($key, pop(@{ $push_stack{$key} }), 1); + return 0; + } + + # shell escape + if (s/^\/\!// && s/\s*$// && length) { + system("$_"); + $x = $? >> 8; + print $stdout "*** exited with $x\n" if ($x); + return 0; + } + + if ($_ eq '/help' || $_ eq '/?') { + print <<'EOF'; + + *** BASIC COMMANDS: :a$AAOOOOOOOOOOOOOOOOOAA$a, ================== + +@A:. .:B@+ ANYTHING WITHOUT + /refresh =@B HELP!!! HELP!!! B@= A LEADING / IS + grabs the newest :a$Ao oA$a, SENT AS A TWEET! + tweets right ;AAA$a; :a$AAAAAAAAAAA; ================== + away (or tells :AOaaao:, .:oA*:. JUST TYPE TO TALK! + you if there .;=$$$OBO***+ .+aaaa$: + is nothing new) :*; :***O@Aaaa*o, ============ + by thumping .+++++: o#o REMEMBER!! + the background :OOOOOOA*:::, =@o ,:::::. ============ + process. .+++++++++: =@*.....=a$OOOB#; MANY COMMANDS, AND + =@OoO@BAAA#@$o, ALL TWEETS ARE + /again =@o .+aaaaa: --ASYNCHRONOUS-- + displays most recent =@Aaaaaaaaaa*o*a;, and might not always + tweets, both old and =@$++=++++++:,;+aA: respond + new. ,+$@*.=O+ ...oO; oAo+. immediately! + ,+o$OO=.+aA#####Oa;.*OO$o+. + /dm and /dmagain for DMs. +Ba::;oaa*$Aa=aA$*aa=;::$B: + ,===O@BOOOOOOOOO#@$===, + /replies o@BOOOOOOOOO#@+ ================== + shows replies and mentions. o@BOB@B$B@BO#@+ USE + FOR A COUNT: + o@*.a@o a@o.$@+ /re +30 => last 30 replies + /quit resumes your boring life. o@B$B@o a@A$#@+ ========================== +EOF + &linein("PRESS RETURN/ENTER>"); + print <<"EOF"; + ++- MORE COMMANDS -+ -=-=- USER STUFF -=-=- +| | /whois username displays info about username +| See the TTYtter | /again username views their most recent tweets +| home page for | /wagain username combines them all +| complete list | /follow username follow a username +| | /leave username stop following a username ++-----------------+ /dm username message send a username a DM ++--- TWEET AND DM SELECTION -------------------------------------------------+ +| all DMs and tweets have menu codes (letters + number, d for DMs). example: | +| a5> <ttytter> Send me Dr Pepper http://www.floodgap.com/TTYtter | +| [DM da0][ttytter/Sun Jan 32 1969] I think you are cute | +| /reply a5 message replies to tweet a5 | +| example: /reply a5 I also like Dr Pepper | +| becomes \@ttytter I also like Dr Pepper (and is threaded) | +| /thread a5 if a5 is part of a thread (the username | +| has a \@) then show all posts up to that | +| /url a5 opens all URLs in tweet a5 | +| Mac OS X users, do first: /set urlopen open %U | +| Dummy terminal users, try /set urlopen lynx -dump %U | more | +| /delete a5 deletes tweet a5, if it's your tweet | +| /rt a5 retweets tweet a5: RT \@tytter: Send me...| ++-- Abbreviations: /re, /th, /url, /del --- menu codes wrap around at end ---+ +=====> /reply, /delete and /url work for direct message menu codes too! <===== +EOF + &linein("PRESS RETURN/ENTER>"); + print <<"EOF"; + + + +Use /set to turn on options or set them at runtime. There is a BIG LIST! + +>> EXAMPLE: WANT ANSI? /set ansi 1 + or use the -ansi command line option. + WANT TO VERIFY YOUR TWEETS BEFORE POSTING? /set verify 1 + or use the -verify command line option. +For more, like readline support, UTF-8, SSL, proxies, etc., see the docs. + +** READ THE COMPLETE DOCUMENTATION: http://www.floodgap.com/software/ttytter/ + + TTYtter $TTYtter_VERSION is (c)2011 cameron kaiser + contributors. + all rights reserved. this software is offered AS IS, with no guarantees. it + is not endorsed by Obvious or the executives and developers of Twitter. + + *** subscribe to updates at http://twitter.com/ttytter + or http://twitter.com/floodgap + send your suggestions to me at ckaiser\@floodgap.com + or http://twitter.com/doctorlinguist + + + +EOF + return 0; + } + if ($_ eq '/ruler' || $_ eq '/ru') { + my ($prompt, $prolen) = (&$prompt(1)); + $prolen = " " x $prolen; + print $stdout <<"EOF"; +${prolen} 1 2 3 4 5 6 7 8 9 0 1 2 3 XX +${prompt}1...5....0....5....0....5....0....5....0....5....0....5....0....5....0....5....0....5....0....5....0....5....0....5....0....5....0....5...XX +EOF + return 0; + } + if ($_ eq '/cls' || $_ eq '/clear') { + if ($ansi) { + print $stdout "${ESC}[H${ESC}[2J\n"; + } else { + print $stdout ("\n" x ($ENV{'ROWS'} || 50)); + } + return 0; + } + if ($_ eq '/refresh' || $_ eq '/thump' || $_ eq '/r') { + &thump; + return 0; + } + if (m#^/a(gain)?(\s+\+\d+)?$#) { # the asynchronous form + my $countmaybe = $2; + $countmaybe =~ s/[^\d]//g if (length($countmaybe)); + $countmaybe += 0; + if ($countmaybe > 999) { + print $stdout "-- greedy bastard, try +fewer.\n"; + return 0; + } + $countmaybe = sprintf("%03i", $countmaybe); + print $stdout "-- background request sent\n" unless ($synch); + + print C "reset${countmaybe}-----------\n"; + &sync_semaphore; + return 0; + } + + # this is for users -- list form is below + if ($_ =~ m#^/(w)?a(gain)?\s+(\+\d+\s+)?([^\s/]+)$#) { #synchronous form + my $mode = $1; + my $uname = lc($4); + + my $countmaybe = $3; + $countmaybe =~ s/[^\d]//g if (length($countmaybe)); + $countmaybe += 0; + + $uname =~ s/^\@//; + $readline_completion{'@'.$uname}++ if ($termrl); + print $stdout + "-- synchronous /again command for $uname ($countmaybe)\n" + if ($verbose); + my $my_json_ref = + &grabjson("${uurl}?screen_name=${uname}&include_rts=true", + 0, 0, $countmaybe); + &dt_tdisplay($my_json_ref, 'again'); + unless ($mode eq 'w' || $mode eq 'wf') { + return 0; + } # else fallthrough + } + if ($_ =~ m#^/w(hois|a|again)?\s+(\+\d+\s+)?\@?([^\s]+)#) { + my $uname = lc($3); + $uname =~ s/^\@//; + $readline_completion{'@'.$uname}++ if ($termrl); + print $stdout "-- synchronous /whois command for $uname\n" + if ($verbose); + my $my_json_ref = + &grabjson("${wurl}?screen_name=${uname}", 0); + + if (defined($my_json_ref) && ref($my_json_ref) eq 'HASH' && + length($my_json_ref->{'screen_name'})) { + my $sturl = undef; + my $purl = + &descape($my_json_ref->{'profile_image_url'}); + if ($avatar && length($purl) && $purl !~ +m#^http://[^.]+\.(twimg\.com|twitter\.com).+/images/default_profile_\d+_normal.png#) { + my $exec = $avatar; + my $fext; + ($purl =~ /\.([a-z0-9A-Z]+)$/) && + ($fext = $1); + if ($purl !~ /['\\]/) { # careful! + $exec =~ s/\%U/'$purl'/g; + $exec =~ s/\%N/$uname/g; + $exec =~ s/\%E/$fext/g; + print $stdout "\n"; + print $stdout "($exec)\n" + if ($verbose); + system($exec); + } + } + print $stdout "\n"; + &userline($my_json_ref, $stdout); + print $stdout &wwrap( +"\"@{[ &strim(&descape($my_json_ref->{'description'})) ]}\"\n") + if (length(&strim($my_json_ref->{'description'}))); + if (length($my_json_ref->{'url'})) { + $sturl = + $urlshort = &descape($my_json_ref->{'url'}); + $urlshort =~ s/^\s+//; + $urlshort =~ s/\s+$//; + print $stdout "${EM}URL:${OFF}\t\t$urlshort\n"; + } + print $stdout &wwrap( +"${EM}Location:${OFF}\t@{[ &descape($my_json_ref->{'location'}) ]}\n") + if (length($my_json_ref->{'location'})); + print $stdout <<"EOF"; +${EM}Picture:${OFF}\t@{[ &descape($my_json_ref->{'profile_image_url'}) ]} + +EOF + unless ($anonymous || $whoami eq $uname) { + my $g = + &grabjson("$frurl?user_a=$whoami&user_b=$uname", 0); + print $stdout &wwrap( + "${EM}Do you follow${OFF} this user? ... ${EM}$g->{'literal'}${OFF}\n") + if (ref($g) eq 'HASH'); + my $g = + &grabjson("$frurl?user_a=$uname&user_b=$whoami", 0); + print $stdout &wwrap( +"${EM}Does this user follow${OFF} you? ... ${EM}$g->{'literal'}${OFF}\n") + if (ref($g) eq 'HASH'); + print $stdout "\n"; + } + print $stdout &wwrap( + "-- %URL% is now $urlshort (/short shortens, /url opens)\n") + if (defined($sturl)); + } + return 0; + } + + if (m#^/(df|doesfollow)\s+\@?([^\s]+)$#) { + if ($anonymous) { + print $stdout "-- who follows anonymous anyway?\n"; + return 0; + } + $_ = "/doesfollow $2 $whoami"; + print $stdout "*** assuming you meant: $_\n"; + # fall through to ... + } + if (m#^/(df|doesfollow)\s+\@?([^\s]+)\s+\@?([^\s]+)$#) { + my $user_a = $2; + my $user_b = $3; + if ($user_a =~ m#/# || $user_b =~ m#/#) { + print $stdout "--- sorry, this won't work on lists.\n"; + return 0; + } + my $g = &grabjson( + "${frurl}?user_a=${user_a}&user_b=${user_b}", 0); + if ($g->{'ok'}) { + print $stdout "--- does $user_a follow ${user_b}? => "; + print $streamout "$g->{'literal'}\n" + } + return 0; + } + + # this handles lists too. + if(s#^/(frs|friends|fos|followers)(\s+\+\d+)?\s*##) { + my $countmaybe = $2; + my $mode = $1; + my $arg = lc($_); + my $lname = ''; + my $user = ''; + my $what = ''; + $arg =~ s/^@//; + $who = $arg; + ($who, $lname) = split(m#/#, $arg, 2) if (m#/#); + if (length($lname) && !length($user) && $anonymous) { + print $stdout + "-- you must specify a username for a list when anonymous.\n"; + return 0; + } + if (!length($lname)) { + $user = "&screen_name=$_" if length; + $what = ($mode eq 'frs' || $mode eq 'friends') + ? "friends" : "followers"; + $mode = ($mode eq 'frs' || $mode eq 'friends') + ? $friendsurl : $followersurl; + $who = "user $who"; + } else { + $who ||= $whoami; + $what = ($mode eq 'frs' || $mode eq 'friends') + ? "friends/members" : "followers/subscribers"; + $mode = ($mode eq 'frs' || $mode eq 'friends') + ? $getliurl : $getfliurl; + $mode = &liurltourl($mode, $lname, $who); + $who = "list $who/$lname"; + $user = ''; + } + $countmaybe =~ s/[^\d]//g if (length($countmaybe)); + $countmaybe += 0; + $countmaybe ||= 20; + + # we use the undocumented count= support to, by default, + # reduce the JSON parsing overhead. if we always had to take + # all 100, we really eat it on parsing. the downside is that, + # per @episod, the stuff we get is "less" fresh. + my $countper = ($countmaybe < 100) ? $countmaybe : 100; + + # loop through using the cursor until desired number. + my $cursor = -1; # initial value + my $printed = 0; + my $nofetch = 0; + my $json_ref = undef; + my @usarray = undef; shift(@usarray); # force underflow + + FABIO: while($countmaybe--) { + if(!scalar(@usarray)) { + last FABIO if ($nofetch); + $json_ref = &grabjson( + "${mode}?count=${countper}&cursor=${cursor}${user}"); + @usarray = @{ $json_ref->{'users'} }; + last FABIO if (!scalar(@usarray)); + $cursor = $json_ref->{'next_cursor_str'} || + $json_ref->{'next_cursor'} || -1; + $nofetch = ($cursor < 1) ? 1 : 0; + } + &$userhandle(shift(@usarray)); + $printed++; + } + print $stdout "-- sorry, no $what found for $who.\n" + if (!$printed); + return 0; + } + + # threading + if (m#^/th(read)?\s+(\+\d+\s+)?([zZ]?[a-zA-Z][0-9])$#) { + my $countmaybe = $2; + if (length($countmaybe)) { + print $stdout + "-- /thread does not (yet) support +count\n"; + return 0; + } + my $code = lc($3); + my $tweet = &get_tweet($code); + if (!defined($tweet)) { + print $stdout "-- no such tweet (yet?): $code\n"; + return 0; + } + my $limit = 9; + my $id = $tweet->{'retweeted_status'}->{'id_str'} || + $tweet->{'in_reply_to_status_id_str'}; + my $thread_ref = [ $tweet ]; + while ($id && $limit) { + print $stdout "-- thread: fetching $id\n" + if ($verbose); + my $next = &grabjson("${idurl}/${id}.json", 0); + $id = 0; + $limit--; + if (defined($next) && ref($next) eq 'HASH') { + push(@{ $thread_ref }, + &fix_geo_api_data($next)); + $id = $next->{'retweeted_status'}->{'id_str'} + || $next->{'in_reply_to_status_id_str'} + || 0; + } + } + &tdisplay($thread_ref, 'thread', 0, 1); # use the mini-menu + return 0; + } + + # pull out entities. this works for DMs and tweets. + # btw: T.CO IS WACK. + if (m#^/ent?(ities)? ([dDzZ]?[a-zA-Z][0-9])$#) { + my $v; + my $w; + my $thing; + my $genurl; + my $code = lc($2); + my $hash; + if ($code =~ /^d.[0-9]$/) { + $hash = &get_dm($code); + $thing = "DM"; + $genurl = $dmidurl; + } else { + $hash = &get_tweet($code); + $thing = "tweet"; + $genurl = $idurl; + } + + if (!defined($hash)) { + print $stdout "-- no such $thing (yet?): $code\n"; + return 0; + } + + # we don't ordinarily ask for entities, so now we must. + my $id = $hash->{'id_str'}; + $hash = &grabjson("${genurl}/${id}.json?include_entities=1", 0); + if (!defined($hash) || ref($hash) ne 'HASH') { + print $stdout "-- failed to get entities from server, sorry\n"; + return 0; + } + + my $didprint = 0; + # Twitter puts entities in multiple fields. + foreach $w (qw(media urls)) { + my $p = $hash->{'entities'}->{$w}; + next if (!defined($p) || ref($p) ne 'ARRAY'); + foreach $v (@{ $p }) { + next if (!defined($v) || ref($v) ne 'HASH'); + next if (!length($v->{'url'}) || + !length($v->{'expanded_url'})); + my $u1 = &descape($v->{'url'}); + my $u2 = &descape($v->{'expanded_url'}); + print $stdout "$u1 => $u2\n"; + $urlshort = $u1; + $didprint++; + } + } + if ($didprint) { + print $stdout &wwrap( + "-- %URL% is now $urlshort (/url opens)\n"); + } else { + print $stdout "-- no entities or URLs found\n"; + } + return 0; + } + + if (($_ eq '/url' || $_ eq '/open') && length($urlshort)) { + $_ = "/url $urlshort"; + print $stdout "*** assuming you meant %URL%: $_\n"; + # and fall through to ... + } + if (m#^/(url|open)\s+(http|gopher|https|ftp)://.+# && + s#^/(url|open)\s+##) { + &openurl($_); + return 0; + } + if (m#^/(url|open) ([dDzZ]?[a-zA-Z][0-9])$#) { + my $code = lc($2); + my $tweet; + $urlshort = undef; + + if ($code =~ /^d/ && length($code) == 3) { + $tweet = &get_dm($code); # USO! + if (!defined($tweet)) { + print $stdout + "-- no such DM (yet?): $code\n"; + return 0; + } + } else { + $tweet = &get_tweet($code); + if (!defined($tweet)) { + print $stdout + "-- no such tweet (yet?): $code\n"; + return 0; + } + } + my $text = &descape($tweet->{'text'}); + # findallurls + while ($text +# =~ s#(http|https|ftp|gopher)://([a-zA-Z0-9_~/:%\-\+\.\=\&\?\#,]+)##) { +# sigh. I HATE YOU TINYARRO.WS +#TODO +# eventually we will have to put a punycode implementation into openurl +# to handle things like Mac OS X's open which don't understand UTF-8 URLs. + =~ s#(http|https|ftp|gopher)://([^'\\]+?)('|\\|\s|$)##) { + my $url = $1 . "://$2"; + $url =~ s/[\.\?]$//; + &openurl($url); + } + print $stdout "-- sorry, couldn't find any URL.\n" + if (!defined($urlshort)); + return 0; + } + + if (s/^\/(favourites|favorites|faves|favs|fl)(\s+\+\d+)?\s*//) { + my $my_json_ref; + my $countmaybe = $2; + $countmaybe =~ s/[^\d]//g if (length($countmaybe)); + $countmaybe += 0; + + if (length) { + $my_json_ref = &grabjson("${favsurl}/${_}.json", 0, 0, + $countmaybe); + } else { + if ($anonymous) { + print $stdout + "-- sorry, you can't haz favourites if you're anonymous.\n"; + } else { + print $stdout + "-- synchronous /favourites user command\n" + if ($verbose); + $my_json_ref = &grabjson($myfavsurl, 0, 0, + $countmaybe); + } + } + if (defined($my_json_ref) + && ref($my_json_ref) eq 'ARRAY') { + if (scalar(@{ $my_json_ref })) { + my $w = "-==- favourites " x 10; + $w = $EM . substr($w, 0, $wrap || 79) . $OFF; + print $stdout "$w\n"; + &tdisplay($my_json_ref, "favourites"); + print $stdout "$w\n"; + } else { + print $stdout + "-- no favourites found, boring impartiality concluded.\n"; + } + } + &$conclude; + return 0; + } + if ( +m#^/(un)?f(rt|retweet|a|av|ave|avorite|avourite)? ([zZ]?[a-zA-Z][0-9])$#) { + my $mode = $1; + my $secondmode = $2; + my $code = lc($3); + $secondmode = ($secondmode eq 'retweet') ? 'rt' : $secondmode; + my $tweet = &get_tweet($code); + if ($mode eq 'un' && $secondmode eq 'rt') { + print $stdout + "-- hmm. seems contradictory. no dice.\n"; + return 0; + } + if (!defined($tweet)) { + print $stdout "-- no such tweet (yet?): $code\n"; + return 0; + } + &cordfav($tweet->{'id_str'}, 1, + (($mode eq 'un') ? $favdelurl : $favurl), + &descape($tweet->{'text'}), + (($mode eq 'un') ? 'removed' : 'created')); + if ($secondmode eq 'rt') { + $_ = "/rt $code"; + # and fall through + } else { + return 0; + } + } + + # Retweet API and manual RTs + if (s#^/([oe]?)r(etweet|t) ([zZ]?[a-zA-Z][0-9])\s*##) { + my $mode = $1; + my $code = lc($3); + my $tweet = &get_tweet($code); + if (!defined($tweet)) { + print $stdout "-- no such tweet (yet?): $code\n"; + return 0; + } + # use a native retweet unless we can't (or user used /ort /ert) + unless ($nonewrts || length || length($mode)) { + # we don't always get rs->text, so we simulate it. + my $text = &descape($tweet->{'text'}); + $text =~ s/^RT \@[^\s]+:\s+// + if ($tweet->{'retweeted_status'}->{'id_str'}); + print $stdout "-- status retweeted\n" + unless(&updatest($text, 1, 0, undef, + $tweet->{'retweeted_status'}->{'id_str'} + || $tweet->{'id_str'})); + return 0; + } + # we can't or user requested /ert /ort + $retweet = "RT @" . + &descape($tweet->{'user'}->{'screen_name'}) . + ": " . &descape($tweet->{'text'}); + if ($mode eq 'e') { + &add_history($retweet); + print $stdout &wwrap( + "-- ok, %RT% and %% are now \"$retweet\"\n"); + return 0; + } + $_ = (length) ? "$retweet $_" : $retweet; + print $stdout &wwrap("(expanded to \"$_\")"); + print $stdout "\n"; + goto TWEETPRINT; # fugly! FUGLY! + } + if (m#^/(re)?rts?of?me?(\s+\+\d+)?$# && !$nonewrts) { +#TODO +# when more fields are added, integrate them over the JSON_ref + my $mode = $1; + my $countmaybe = $2; + $countmaybe =~ s/[^\d]//g if (length($countmaybe)); + $countmaybe += 0; + + my $my_json_ref = &grabjson($rtsofmeurl, 0, 0, $countmaybe); + &dt_tdisplay($my_json_ref, "rtsofme"); + if ($mode eq 're') { + $_ = '/re'; # and fall through ... + } else { + return 0; + } + } + if (m#^/rts?of\s+([zZ]?[a-zA-Z][0-9])$# && !$nonewrts) { + my $code = lc($1); + my $tweet = &get_tweet($code); + my $id; + + if (!defined($tweet)) { + print $stdout "-- no such tweet (yet?): $code\n"; + return 0; + } + $id = $tweet->{'retweeted_status'}->{'id_str'} || + $tweet->{'id_str'}; + if (!$id) { + print $stdout "-- hmmm, that tweet is major bogus.\n"; + return 0; + } + my $url = $rtsbyurl; + $url =~ s/%I/$id/; + my $users_ref = &grabjson("$url?count=100"); + return if (!defined($users_ref) || ref($users_ref) ne 'ARRAY'); + my $k = scalar(@{ $users_ref }); + if (!$k) { + print $stdout + "-- no known retweeters, or they're private.\n"; + return 0; + } + my $j; + foreach $j (@{ $users_ref }) { + &$userhandle($j); + } + print $stdout + "** truncated at 100 retweeters (JACKPOT!!!)\n" + if ($k >= 100); + return 0; + } + + if (m#^/del(ete)?\s+([zZ]?[a-zA-Z][0-9])$#) { + my $code = lc($2); + my $tweet = &get_tweet($code); + if (!defined($tweet)) { + print $stdout "-- no such tweet (yet?): $code\n"; + return 0; + } + if (lc(&descape($tweet->{'user'}->{'screen_name'})) + ne lc($whoami)) { + print $stdout + "-- not allowed to delete somebody's else's tweets\n"; + return 0; + } + print $stdout &wwrap( +"-- verify you want to delete: \"@{[ &descape($tweet->{'text'}) ]}\""); + print $stdout "\n"; + $answer = &linein( + "-- sure you want to delete? (only y or Y is affirmative):"); + if ($answer ne 'y') { + print $stdout "-- ok, tweet is NOT deleted.\n"; + return 0; + } + $lastpostid = -1 if ($tweet->{'id_str'} == $lastpostid); + &deletest($tweet->{'id_str'}, 1); + return 0; + } + # DM delete version + if (m#^/del(ete)? ([dD][a-zA-Z][0-9])$#) { + my $code = lc($2); + my $dm = &get_dm($code); + if (!defined($dm)) { + print $stdout "-- no such DM (yet?): $code\n"; + return 0; + } + print $stdout &wwrap( + "-- verify you want to delete: " . + "(from @{[ &descape($dm->{'sender'}->{'screen_name'}) ]}) ". + "\"@{[ &descape($dm->{'text'}) ]}\""); + print $stdout "\n"; + $answer = &linein( + "-- sure you want to delete? (only y or Y is affirmative):"); + if ($answer ne 'y') { + print $stdout "-- ok, DM is NOT deleted.\n"; + return 0; + } + &deletedm($dm->{'id_str'}, 1); + return 0; + } + # /deletelast + if (m#^/de?l?e?t?e?last$#) { + if (!$lastpostid) { + print $stdout "-- you haven't posted yet this time!\n"; + return 0; + } + if ($lastpostid == -1) { + print $stdout "-- you already deleted it!\n"; + return 0; + } + print $stdout &wwrap( +"-- verify you want to delete: \"$lasttwit\""); + print $stdout "\n"; + $answer = &linein( + "-- sure you want to delete? (only y or Y is affirmative):"); + if ($answer ne 'y') { + print $stdout "-- ok, tweet is NOT deleted.\n"; + return 0; + } + &deletest($lastpostid, 1); + $lastpostid = -1; + return 0; + } + + if (s#^/(v)?re(ply)? ([zZ]?[a-zA-Z][0-9]) ## && length) { + my $mode = $1; + my $code = lc($3); + my $tweet = &get_tweet($code); + if (!defined($tweet)) { + print $stdout "-- no such tweet (yet?): $code\n"; + return 0; + } + my $target = &descape($tweet->{'user'}->{'screen_name'}); + $_ = '@' . $target . " $_"; + unless ($mode eq 'v') { + $in_reply_to = $tweet->{'id_str'}; + $expected_tweet_ref = $tweet; + } else { + $_ = ".$_"; + } + $readline_completion{'@'.lc($target)}++ if ($termrl); + print $stdout &wwrap("(expanded to \"$_\")"); + print $stdout "\n"; + goto TWEETPRINT; # fugly! FUGLY! + } + # DM reply version + if (s#^/(dm)?re(ply)? ([dD][a-zA-Z][0-9]) ## && length) { + my $code = lc($3); + my $dm = &get_dm($code); + if (!defined($dm)) { + print $stdout "-- no such DM (yet?): $code\n"; + return 0; + } + # in the future, add DM in_reply_to here + my $target = &descape($dm->{'sender'}->{'screen_name'}); + $readline_completion{'@'.lc($target)}++ if ($termrl); + $_ = "/dm $target $_"; + print $stdout &wwrap("(expanded to \"$_\")"); + print $stdout "\n"; + # and fall through to ... + } + + if (m#^/re(plies)?(\s+\+\d+)?$#) { + my $countmaybe = $2; + $countmaybe =~ s/[^\d]//g if (length($countmaybe)); + $countmaybe += 0; + + if ($anonymous) { + print $stdout + "-- sorry, how can anyone reply to you if you're anonymous?\n"; + } else { + # we are intentionally not keeping track of "last_re" + # in this version because it is not automatically + # updated and may not act as we expect. + print $stdout "-- synchronous /replies command\n" + if ($verbose); + my $my_json_ref = &grabjson($rurl, 0, 0, $countmaybe); + &dt_tdisplay($my_json_ref, "replies"); + } + return 0; + } + + # DMs + if ($_ eq '/dm' || $_ eq '/dmrefresh' || $_ eq '/dmr') { + &dmthump; + return 0; + } + # /dmsent, /dmagain + if (m#^/dm(s|sent|a|again)(\s+\+\d+)?$#) { + my $mode = $1; + my $countmaybe = $2; + $countmaybe =~ s/[^\d]//g if (length($countmaybe)); + $countmaybe += 0; + if ($countmaybe > 999) { + print $stdout "-- greedy bastard, try +fewer.\n"; + return 0; + } + $countmaybe = sprintf("%03i", $countmaybe); + print $stdout "-- background request sent\n" unless ($synch); + + $mode = ($mode =~ /^s/) ? 's' : 'd'; + print C "${mode}mreset${countmaybe}---------\n"; + &sync_semaphore; + return 0; + } + if (s#^/dm \@?([^\s]+)\s+## && length) { + return &common_split_post($_, undef, $1); + } + + # follow and leave users + if (m#^/(follow|leave|unfollow) \@?([^\s/]+)$#) { + my $m = $1; + my $u = lc($2); + &foruuser($u, 1, + (($m eq 'follow') ? $followurl : $leaveurl), + (($m eq 'follow') ? 'started' : 'stopped')); + return 0; + } + + # follow and leave lists. this is, frankly, pointless; it does + # nothing other than to mark you. otherwise, /liston and /listoff + # actually add lists to your timeline. + if (m#^/(l?follow|l?leave|l?unfollow) \@?([^\s/]*)/([^\s/]+)$#) { + my $m = $1; + my $uname = lc($2); + my $lname = lc($3); + + if (!length($uname) || $uname eq $whoami) { + print $stdout &wwrap( +"** you can't mark/unmark yourself as a follower of your own lists!\n"); + print $stdout &wwrap( +"** to add/remove your own lists from your timeline, use /liston /listoff\n"); + return 0; + } + if ($m !~ /^l/) { + print $stdout &wwrap( +"-- to mark/unmark you as a follower of a list, use /lfollow /lleave\n"); + print $stdout &wwrap( +"-- to add/remove your own lists from your timeline, use /liston /listoff\n"); + return 0; + } + + my $r = &postjson(&liurltourl($getfliurl, $lname, $uname), + (($m ne 'lfollow') ? "_method=DELETE&" : ""). + "list_id=$lname" + ); + if ($r) { + my $t = ($m eq 'lfollow') ? "" : "un"; + print $stdout &wwrap( +"*** ok, you are now ${t}marked as a follower of $uname/${lname}.\n"); + my $c = ($t eq 'un') ? "off" : "on"; + $t = ($t eq 'un') ? "remove from" : "add to"; + print $stdout &wwrap( +"--- to also $t your timeline, use /list${c}\n"); + } + return 0; + } + + # block and unblock users + if (m#^/(block|unblock) \@?([^\s/]+)$#) { + my $m = $1; + my $u = lc($2); + if ($m eq 'block') { + $answer = &linein( + "-- sure you want to block $u? (only y or Y is affirmative):"); + if ($answer ne 'y') { + print $stdout "-- ok, $u is NOT blocked.\n"; + return 0; + } + } + &boruuser($u, 1, + (($m eq 'block') ? $blockurl : $blockdelurl), + (($m eq 'block') ? 'started' : 'stopped')); + return 0; + } + + # list support + # /withlist (/withlis, /with, /wl) + if (s#^/(withlist|withlis|withl|with|wl)\s+([^/\s]+)\s+## && + ($lname=lc($2)) && s/\s*$// && length) { + my $comm = ''; + my $args = ''; + my $dont_return = 0; + if ($anonymous) { + print $stdout "-- no list love for anonymous\n"; + return 0; + } + if (/\s+/) { + ($comm, $args) = split(/\s+/, $_, 2); + } else { + $comm = $_; + } + + my $return; + # this is a Twitter bug -- it will not give you the + # new slug in the returned hash. + my $state = "modified list $lname (WAIT! then /lists to see new slug)"; + if ($comm eq 'create') { + my $desc; + ($args, $desc) = split(/\s+/, $args, 2) + if ($args =~ /\s+/); + if ($args ne 'public' && $args ne 'private') { + print $stdout + "-- must specify public or private\n"; + return 0; + } + $state = "created new list $lname (mode $args)"; + $desc = "description=".&url_oauth_sub($desc)."&" + if (length($desc)); + $return = &postjson(&liurltourl($getlisurl, $lname), + "${desc}mode=$args&name=$lname"); + } elsif ($comm eq 'private' || $comm eq 'public') { + $return = &postjson(&liurltourl($modifyliurl, $lname), + "mode=$comm"); + } elsif ($comm eq 'desc' || $comm eq 'description') { + if (!length($args)) { + print $stdout "-- $comm needs an argument\n"; + return 0; + } + $return = &postjson(&liurltourl($modifyliurl, $lname), + "description=".&url_oauth_sub($args)); + } elsif ($comm eq 'name') { + if (!length($args)) { + print $stdout "-- $comm needs an argument\n"; + return 0; + } + $return = &postjson(&liurltourl($modifyliurl, $lname), + "name=".&url_oauth_sub($args)); + $state = "RENAMED list $lname (WAIT! then /lists to see new slug)\n"; + } elsif ($comm eq 'add' || $comm eq 'adduser') { + $state = "user(s) added to list $lname"; + if ($args !~ /,/ || $args =~ /\s+/) { + 1 while ($args =~ s/\s+/,/); + } + if ($args =~ /\s*,\s+/ || $args =~ /\s+,\s*/) { + 1 while ($args =~ s/\s+//); + } + if (!length($args)) { + print $stdout "-- $comm needs an argument\n"; + return 0; + } + print $stdout "--- warning: user list not checked\n"; + $return = &postjson(&liurltourl($adduliurl, $lname), + "screen_name=".&url_oauth_sub($args)); + } elsif ($comm eq 'delete' && !length($args)) { + $state = "deleted list $lname"; + print $stdout + "-- verify you want to delete list $lname\n"; + my $answer = &linein( + "-- sure you want to delete? (only y or Y is affirmative):"); + if ($answer ne 'y') { + print $stdout "-- ok, list is NOT deleted.\n"; + return 0; + } + $return = &postjson(&liurltourl($modifyliurl, $lname), + "_method=DELETE"); + if ($return) { + # check and see if this is in our autolists. + # if it is, delete it there too. + my $value = &getvariable('lists'); + &setvariable('lists', $value, 1) + if ($value=~s#(^|,)${whoami}/${lname}($|,)##); + } + } elsif ($comm eq 'delete') { + if ($args =~ /[,\s+]/) { + print $stdout "-- one at a time, please\n"; + return 0; + } + # look up the id, since delete doesn't do screen names + my $my_json_ref = + &grabjson("${wurl}?screen_name=$args", 0); + if ($my_json_ref && ref($my_json_ref) eq 'HASH') { + $state = "removed user $args from list $lname"; + my $id = $my_json_ref->{'id_str'} || + $my_json_ref->{'id'}; + $return = &postjson(&liurltourl($getliurl, + $lname), + "_method=DELETE&id=$id&list_id=$lname"); + } + } elsif ($comm eq 'list') { # synonym for /list + $_ = "/list /$lname"; + $dont_return = 1; # and fall through + } else { + print $stdout "*** illegal list operation $comm\n"; + } + if ($return) { + print $stdout "*** ok, $state\n"; + } + return 0 unless ($dont_return); + } + + # /a to show statuses in a list + if (m#^/a(gain)?\s+(\+\d+\s+)?\@?([^\s/]*)/([^\s/]+)#) { + my $uname = lc($3); + if ($anonymous && !length($uname)) { + print $stdout "-- you must specify a username when anonymous.\n"; + return 0; + } + my $lname = lc($4); + my $countmaybe = $2; + $countmaybe =~ s/[^\d]//g if (length($countmaybe)); + $countmaybe += 0; + + my $my_json_ref = + &grabjson(&liurltourl($statusliurl, $lname, $uname), + 0, 0, $countmaybe); + &dt_tdisplay($my_json_ref, "again"); + return 0; + } + + # /lists command: if @, show their lists. if @?../... show that list. + # trivially duplicates /frs and /fos for lists + # also handles /listfos and /listfrs + if (length($whoami) && + (m#^/list?s?$# || m#^/list?f[ro](llower|iend)?s$#)) { + $_ .= " $whoami"; + } + if (m#^/lis(t|ts|t?fos|tfollowers|t?frs|tfriends)?\s+(\+\d+\s+)?(\@?[^\s]+)$#) { + my $mode = $1; + my $countmaybe = $2; + my $uname = lc($3); + my $lname = ''; + + $mode = ($mode =~ /^t?fo/) ? 'fo' : + ($mode =~ /^t?fr/) ? 'fr' : + ''; + $uname =~ s/^\@//; + ($uname, $lname) = split(m#/#, $uname, 2) if ($uname =~ m#/#); + if ($anonymous && !length($uname) && length($mode)) { + print $stdout "-- you must specify a username when anonymous.\n"; + return 0; + } + $uname ||= $whoami; + if (length($lname) && length($mode)) { + print $stdout "-- specify username only\n"; + return 0; + } + + $countmaybe =~ s/[^\d]//g if (length($countmaybe)); + $countmaybe += 0; + $countmaybe ||= 20; + + # this is copied from /friends and /followers (q.v.) + my $countper = ($countmaybe < 100) ? $countmaybe : 100; + + my $cursor = -1; # initial value + my $nofetch = 0; + my $printed = 0; + my $json_ref = undef; + my @usarray = undef; shift(@usarray); # force underflow + my $furl = &liurltourl((length($lname) ? $getliurl + : ($mode eq '') ? $getlisurl + : ($mode eq 'fo') ? $getuliurl + : $getufliurl) , + $lname, $uname); + + LABIO: while($countmaybe--) { + if(!scalar(@usarray)) { + last LABIO if ($nofetch); + $json_ref = &grabjson( + "${furl}?count=${countper}&cursor=${cursor}"); + @usarray = @{ $json_ref->{ + ((length($lname)) ? 'users' : 'lists') + } }; + last LABIO if (!scalar(@usarray)); + $cursor = $json_ref->{'next_cursor_str'} || + $json_ref->{'next_cursor'} || -1; + $nofetch = ($cursor < 1) ? 1 : 0; + } + my $list_ref = shift(@usarray); + if (length($lname)) { + &$userhandle($list_ref); + } else { + # listhandle? + my $list_name = +"\@$list_ref->{'user'}->{'screen_name'}/@{[ &descape($list_ref->{'slug'}) ]}"; + my $list_full_name = + (length($list_ref->{'name'})) ? +&descape($list_ref->{'name'})."${OFF} ($list_name)" : $list_name; + my $list_mode = + (lc(&descape($list_ref->{'mode'})) ne 'public') ? +" ${EM}(@{[ ucfirst(&descape($list_ref->{'mode'})) ]})${OFF}" : ""; + print $streamout <<"EOF"; +${CCprompt}$list_full_name${OFF} (f:$list_ref->{'member_count'}/$list_ref->{'subscriber_count'})$list_mode +EOF + my $desc = &strim(&descape($list_ref->{'description'})); + my $klen = ($wrap || 79) - 9; + $klen = 10 if ($klen < 0); + $desc = substr($desc, 0, $klen)."..." + if (length($desc) > $klen); + print $streamout (' "' . $desc . '"' . "\n") + if (length($desc)); + } + $printed++; + } + if (!$printed) { + print $stdout ((length($lname)) + ? "-- list $uname/$lname does not follow anyone.\n" + : ($mode eq 'fr') + ? "-- user $uname doesn't follow any lists.\n" + : ($mode eq 'fo') + ? "-- user $uname isn't followed by any lists.\n" + : "-- no lists found for user $uname.\n"); + } + return 0; + } + + &sync_n_quit if ($_ eq '/end' || $_ eq '/e'); + + ##### + # + # below this point, we are posting + # + ##### + + if (m#^/me\s#) { + $slash_first = 0; # kludge! + } + + if ($slash_first) { + if (!m#^//#) { + print $stdout "*** invalid command\n"; + print $stdout "*** to pass as a tweet, type /%%\n"; + return 0; + } + s#^/##; # leave the second slash on + } + +TWEETPRINT: # fugly! FUGLY! + return &common_split_post($_, $in_reply_to, undef); +} + +# this turns list URL templates into fully qualified URLs +sub liurltourl { + my $url = shift; + my $list = shift; # null allowed! + my $user = shift || $whoami; + + die("assert: list URL access without effuser\n") if (!length($user)); + $url =~ s/%U/$user/g; + $url =~ s/%L/$list/g; + return $url; +} + +# this is the common code used by standard updates and by the /dm command. +sub common_split_post { + my $k = shift; + my $in_reply_to = shift; + my $dm_user = shift; + + my $dm_lead = (length($dm_user)) ? "/dm $dm_user " : ''; + my $ol = "$dm_lead$k"; + + my (@tweetstack) = &csplit($k, ($autosplit eq 'char' || + $autosplit eq 'cut') ? 1 : 0); + my $m = shift(@tweetstack); + if (scalar(@tweetstack)) { + $l = "$dm_lead$m"; + $history[0] = $l; + if (!$autosplit) { + print $stdout &wwrap( +"*** sorry, too long to send; ". +"truncated to \"$l\" (@{[ length($m) ]} chars)\n"); + print $stdout "*** use %% for truncated version, or append to %%.\n"; + return 0; + } + print $stdout &wwrap( + "*** over $linelength; autosplitting to \"$l\"\n"); + } + # there was an error; stop autosplit, restore original command + if (&updatest($m, 1, $in_reply_to, $dm_user)) { + $history[0] = $ol; + return 0; + } + if (scalar(@tweetstack)) { + $k = shift(@tweetstack); + $l = "$dm_lead$k"; + &add_history($l); + print $stdout &wwrap("*** next part is ready: \"$l\"\n"); + print $stdout "*** (this will also be automatically split)\n" + if (length($k) > $linelength); + print $stdout + "*** to send this next portion, use %%.\n"; + } + return 1; +} + +# helper functions for the command line processor. +sub add_history { + my $h = shift; + + @history = (($h, @history)[0..&min(scalar(@history), $maxhist)]); + if ($termrl) { + if ($termrl->Features()->{'canSetTopHistory'}) { + $termrl->settophistory($h); + } else { + $termrl->addhistory($h); + } + } +} +sub sub_helper { + my $r = shift; + my $s = shift; + my $g = shift; + my $x; + my $q = 0; + my $proband; + + if ($r eq '%') { + $x = -1; + } else { + $x = $r + 0; + } + if (!$x || $x < -(scalar(@history))) { + print $stdout "*** illegal history index\n"; + return (0, $_, undef, undef, undef); + } + $proband = $history[-($x + 1)]; + if ($s eq '--') { + $q = 1; + } elsif ($s eq '*') { + if ($x != -1 || !length($shadow_history)) { + print $stdout + "*** can only %%* on most recent command\n"; + return (0, $_, undef, undef, undef); + } + # we assume it's at the end; it's only relevant there + $proband = substr($shadow_history, length($g)-(2+length($r))); + } else { + $q = -(0+$s); + } + if ($q) { + my $j; + my $c; + for($j=0; $j<$q; $j++) { + $c++ if ($proband =~ s/\s+[^\s]+$//); + } + if ($j != $c) { + print $stdout "*** illegal word index\n"; + return (0, $_, undef, undef, undef); + } + } + return (1, $proband, $r, $s); +} + +# this is used for synchronicity mode to make sure we receive the +# GA semaphore from the background before printing another prompt. +sub sync_console { + &thump; + &dmthump unless (!$dmpause); +} +sub sync_semaphore { + if ($synch) { + my $k = ''; + + while(!length($k)) { + sysread(W, $k, 1); + } # wait for semaphore + } +} + +# wrapper function to get a line from the terminal. +sub linein { + my $prompt = shift; + my $return; + + return 'y' if ($script); + + $prompt .= " "; + if ($termrl) { + $dont_use_counter = 1; + eval '$termrl->hook_no_counter'; + $return = $termrl->readline($prompt); + $dont_use_counter = $nocounter; + eval '$termrl->hook_no_counter'; + } else { + print $stdout $prompt; + chomp($return = lc(<$stdin>)); + } + return $return; +} + +#### this is the background part of the process #### + +MONITOR: +%store_hash = (); +$is_background = 1; +$first_synch = $synchronous_mode = 0; +$rin = ''; +vec($rin,fileno(STDIN),1) = 1; +# paranoia +binmode($stdout, ":crlf") if ($termrl); +unless ($seven) { + binmode(STDIN, ":utf8"); + binmode($stdout, ":utf8"); +} +$interactive = $previous_last_id = $we_got_signal = 0; +$suspend_output = -1; +$dm_first_time = ($dmpause) ? 1 : 0; +$SIG{'BREAK'} = $SIG{'INT'} = 'IGNORE'; # we only respond to SIGKILL/SIGTERM +# debugging for broken systems +$SIG{'ALRM'} = sub { +# remove this in TTYtter 1.2 if no other problems reported + warn("** your system's select() call is ignoring timeouts **\n" . + "** report your operating system to ckaiser\@floodgap.com **\n") + if ($freezebug); + $we_got_signal = 1; +}; +# allow foreground process to squelch us +# freaking Linux signals encore. SIGSYS? really? wtf, Linus! +# well, never mind. Solaris makes us use SIGXCPU/SIGXFSZ +$SIG{'USR1'} = $SIG{'PWR'} = $SIG{'XCPU'} = sub { + $suspend_output ^= 1 if ($suspend_output != -1); + $we_got_signal = 1; +}; +$SIG{'USR2'} = $SIG{'SYS'} = $SIG{'UNUSED'} = $SIG{'XFSZ'} = sub { + $suspend_output = -1; $we_got_signal = 1; +}; + +# loop until we are killed or told to stop. +# we receive instructions on stdin, and send data back on our pipe(). +for(;;) { + &$heartbeat; + &update_effpause; + $wrapseq = 0; # remember, we don't know when commands are sent. + &refresh($interactive, $previous_last_id) unless + ($dont_refresh_first_time || (!$effpause && !$interactive)); + $dont_refresh_first_time = 0; + $previous_last_id = $last_id; + if ($dmpause && ($effpause || $synch)) { + if ($dm_first_time) { + &dmrefresh(0); + $dmcount = $dmpause; + } elsif (!$interactive) { + if (!--$dmcount) { + &dmrefresh($interactive); # using dm_first_time + $dmcount = $dmpause; + } + } + } +DONT_REFRESH: + # nrvs is tricky with synchronicity + if (!$synch || ($synch && $synchronous_mode && !$dm_first_time)) { + $k = length($notify_rate) + length($vs) + length($credlog); + # $wrapseq = 0; + if ($k) { + &send_removereadline if ($termrl); + print $stdout $notify_rate; + print $stdout $vs; + print $stdout $credlog; + $wrapseq = 1; + } + $notify_rate = ""; + $vs = ""; + $credlog = ""; + } + print P "0" if ($synchronous_mode && $interactive); + &send_repaint; + alarm ($effpause + $effpause + $effpause) if ($freezebug); + # security blanket warning + # this core loop is tricky. most signals will not restart the call. + # -- respond to alarms if we are ignoring our timeout. + # -- do not respond to bogus packets if a signal handler triggered it. + # -- clear our flag when we detect a signal handler has been called. +RESTART_SELECT: + $interactive = 0; + $we_got_signal = 0; # acknowledge all signals + $nfound = select($rout = $rin, undef, undef, $effpause); + if ($nfound > 0) { + # there is data on our socket. + # command packets should always be (initially) 20 characters. + # if we come up short, it's either a bug, signal or timeout. + if (sysread(STDIN, $rout, 20) != 20 && $we_got_signal) { + goto RESTART_SELECT; + } + $we_got_signal = 0; + alarm 0 if ($freezebug); + # background communications central command code + # we received a command from the console, so let's look at it. + print $stdout "-- command received ", scalar + localtime, " $rout" if ($verbose); + if ($rout =~ /^rsga/) { + $suspend_output = 0; # reset our status + goto RESTART_SELECT; + } elsif ($rout =~ /^pipet (..)/) { + my $key = &get_tweet($1); + my $ms = $key->{'menu_select'} || 'XX'; + my $ds = $key->{'created_at'} || 'argh, no created_at'; + $ds =~ s/\s/_/g; + my $src = $key->{'source'} || 'unknown'; + $src =~ s/\|//g; # shouldn't be any anyway. + $key = substr(( "$ms ".($key->{'id_str'})." ". + ($key->{'in_reply_to_status_id_str'})." ". + ($key->{'retweeted_status'}->{'id_str'})." ". + ($key->{'user'}->{'geo_enabled'} || "false") . " ". + ($key->{'geo'}->{'coordinates'}->[0]). " ". + ($key->{'geo'}->{'coordinates'}->[1]). " ". + $key->{'tag'}->{'type'}. " ". # NO SPACES! + unpack("${pack_magic}H*", $key->{'tag'}->{'payload'}). " ". + ($key->{'retweet_count'} || "0") . " " . + $key->{'user'}->{'screen_name'}." $ds $src|". + unpack("${pack_magic}H*", $key->{'text'}). + $space_pad), 0, 1024); + print P $key; + goto RESTART_SELECT; + } elsif ($rout =~ /^piped (..)/) { + my $key = $dm_store_hash{$1}; + my $ms = $key->{'menu_select'} || 'XX'; + my $ds = $key->{'created_at'} || 'argh, no created_at'; + $ds =~ s/\s/_/g; + $key = substr(( "$ms ".($key->{'id_str'})." ". + $key->{'sender'}->{'screen_name'}." $ds ". + unpack("${pack_magic}H*", $key->{'text'}). + $space_pad), 0, 1024); + print P $key; + goto RESTART_SELECT; + } elsif ($rout =~ /^ki ([^\s]+) /) { + my $key = $1; + my $module; + sysread(STDIN, $module, 1024); + $module =~ s/\s+$//; + $module = pack("H*", $module); + print $stdout "-- fetch for module $module key $key\n" + if ($verbose); + print P substr(unpack("${pack_magic}H*", + $master_store->{$module}->{$key}).$space_pad, + 0, 1024); + goto RESTART_SELECT; + } elsif ($rout =~ /^kn ([^\s]+) /) { + my $key = $1; + my $module; + sysread(STDIN, $module, 1024); + $module =~ s/\s+$//; + $module = pack("H*", $module); + print $stdout "-- nulled module $module key $key\n" + if ($verbose); + $master_store->{$module}->{$key} = undef; + goto RESTART_SELECT; + } elsif ($rout =~ /^ko ([^\s]+) /) { + my $key = $1; + my $value; + my $module; + sysread(STDIN, $module, 1024); + $module =~ s/\s+$//; + $module = pack("H*", $module); + sysread(STDIN, $value, 1024); + $value =~ s/\s+$//; + print $stdout + "-- set module $module key $key = $value\n" + if ($verbose); + $master_store->{$module}->{$key} = pack("H*", $value); + goto RESTART_SELECT; + } elsif ($rout =~ /^sync/) { + print $stdout "-- synced; exiting at ", + scalar localtime, "\n" + if ($verbose); + exit $laststatus; + } elsif ($rout =~ /^synm/) { + $first_synch = $synchronous_mode = 1; + print $stdout "-- background is now synchronous\n" + if ($verbose); + } elsif ($rout =~ /([\=\?\+])([^ ]+)/) { + $comm = $1; + $key =$2; + if ($comm eq '?') { + print P substr("${$key}$space_pad", 0, 1024); + } else { + sysread(STDIN, $value, 1024); + $value =~ s/\s+$//; + $interactive = ($comm eq '+') ? 0 : 1; + if ($key eq 'tquery') { + print $stdout + "*** custom query installed\n" + if ($interactive || $verbose); + print $stdout + "$value" if ($verbose); + @trackstrings = (); + # already URL encoded + push(@trackstrings, $value); + } else { + $$key = $value; + print $stdout + "*** changed: $key => $$key\n" + if ($interactive || $verbose); + + &generate_ansi if ($key eq 'ansi' || + $key =~ /^colour/); + $rate_limit_next = 0 + if ($key eq 'pause' && + $value eq 'auto'); + &tracktags_makearray + if ($key eq 'track'); + &filter_compile + if ($key eq 'filter'); + ¬ify_compile + if ($key eq 'notifies'); + &list_compile + if ($key eq 'lists'); + } + } + goto RESTART_SELECT; + } else { + $interactive = 1; + ($fetchwanted = 0+$1, $fetch_id = 0, $last_id = 0) + if ($rout =~ /^reset(\d+)/); + ($dmfetchwanted = 0+$1, $last_dm = 0) + if ($rout =~ /^dmreset(\d+)/); + if ($rout =~ /^smreset/) { # /dmsent + $dmfetchwanted = 0+$1 + if ($rout =~ /(\d+)/); + &dmrefresh(1, 1); + &send_repaint; + # we do not want to force a refresh. + goto DONT_REFRESH; + } + if ($rout =~ /^dm/) { + &dmrefresh($interactive); + &send_repaint; + $dmcount = $dmpause; + goto DONT_REFRESH; + } + } + } else { + if ($we_got_signal || $nfound == -1) { + # we need to restart the call. we might be waiting + # longer, but this is unavoidable. + goto RESTART_SELECT; + } + print $stdout +"-- routine refresh (effpause = $effpause, $dmcount to next dm) ", + scalar localtime, "\n" if ($verbose); + } +} + +#### internal implementation functions for the twitter API. DON'T ALTER #### + +# manage automatic rate limiting by checking our max. +#TODO +# autoslowdown as we run out of requests, then speed up when hour +# has passed. +sub update_effpause { + return ($effpause = undef) if ($script); # for select() + if ($pause ne 'auto' && $noratelimit) { + $effpause = (0+$pause) || undef; + return; + } + $effpause = (0+$pause) || undef + if ($anonymous || (!$pause && $pause ne 'auto')); + if (!$rate_limit_next && !$anonymous && ($pause > 0 || + $pause eq 'auto')) { + +# {'reset_time_in_seconds':1218948315,'remaining_hits':98,'reset_time':'Sun Aug 17 04:45:15 +0000 2008','hourly_limit':100} + + $rate_limit_next = 5; + $rate_limit_ref = &grabjson($rlurl, 0); + + if (defined $rate_limit_ref && + ref($rate_limit_ref) eq 'HASH') { + $rate_limit_left = + $rate_limit_ref->{'remaining_hits'}+0; + $rate_limit_rate = + $rate_limit_ref->{'hourly_limit'}+0; + if ($rate_limit_left < 10 && $rate_limit_rate) { + $estring = +"*** warning: $rate_limit_left API requests remain"; + if ($pause eq 'auto') { + $estring .= + "; temporarily halting autofetch"; + $effpause = 0; + } + &$exception(5, "$estring\n"); + } else { + if ($pause eq 'auto') { +# this is computed to give you approximately 50% over the limit for client +# requests +# first, how many requests do we want to make an hour? $dmpause in a sec + $effpause = + $rate_limit_rate - ($rate_limit_rate * 0.5); +# second, take requests away for $dmpause (e.g., 4:1 means reduce by 25%) + $effpause -= + ((1/$dmpause) * $effpause) if ($dmpause); +# third, divide by two (1:1) if replies "mention" streamix is on + $effpause = int($effpause/2) + if ($mentions); +# take 1 request away for each subscription in @listlist (i.e., each one, +# cut effpause in half again). if this gets us below zero, warn here. + if (scalar(@listlist)) { + $effpause = int($effpause/(2**scalar(@listlist))); + if (!$effpause) { +print $stdout "** WARNING: YOU ARE FOLLOWING TOO MANY LISTS SIMULTANEOUSLY!\n"; +print $stdout "** automatic rate limit control cannot manage this many lists\n"; +print $stdout "** to disable this message, use a fixed number with -pause\n"; +print $stdout "** or use /lists or /listoff to reduce the number of lists\n"; +# and fall through to the fallback ha ha ha + } + } +# finally determine how many seconds should elapse + print $stdout + "-- effective pause time zero?!, using fallback 180sec\n" + if (!$effpause && $verbose); + $effpause = + ($effpause) ? int(3600/$effpause) : 180; +# we don't go under sixty. + $effpause = 60 + if ($effpause < 60); + } else { + $effpause = 0+$pause; + } + } + print $stdout +"-- rate limit check: $rate_limit_left/$rate_limit_rate (rate is $effpause sec)\n" + if ($verbose); + $adverb = (!$last_rate_limit) ? ' currently' : + ($last_rate_limit < $rate_limit_rate) ? ' INCREASED to': + ($last_rate_limit > $rate_limit_rate) ? ' REDUCED to': + ''; + $notify_rate = +"-- notification: API rate limit is${adverb} ${rate_limit_rate} req/hr\n" + if ($last_rate_limit != $rate_limit_rate); + $last_rate_limit = $rate_limit_rate; + } else { + $rate_limit_next = 0; + $effpause = ($pause eq 'auto') ? 120 : 0+$pause; + print $stdout +"-- failed to fetch rate limit (rate is $effpause sec)\n" + if ($verbose); + } + } else { + $rate_limit_next-- unless ($anonymous); + } +} + +# thump for timeline +# THIS MUST ONLY BE RUN BY THE BACKGROUND. +sub refresh { + my $interactive = shift; + my $relative_last_id = shift; + my $k; + my $my_json_ref = undef; + my $i; + my @streams = (); + my $dont_roll_back_too_far = 0; + + # this mixes all the tweet streams (timeline, hashtags, replies + # and lists) into a single unified data river. + # backload can be zero, but this will still work since &grabjson + # sees a count of zero as "default." + + # first, get my own timeline + unless ($notimeline) { + my $base_json_ref = &grabjson($url, $fetch_id, 0, + (($last_id) ? 250 : $fetchwanted || $backload), { + "type" => "timeline", + "payload" => "" + }); + # if I can't get my own timeline, ABORT! highest priority! + return if (!defined($base_json_ref) || + ref($base_json_ref) ne 'ARRAY'); + + # we have to filter against the ID cache right now, because + # we might not have any other streams! + if ($fetch_id && $last_id) { + $my_json_ref = []; + my $l; + my %k; # need temporary dedupe + foreach $l (@{ $base_json_ref }) { + unless (length($id_cache{$l->{'id_str'}}) || + $filter_next{$l->{'id_str'}} || + $k{$l->{'id_str'}}) { + push(@{ $my_json_ref }, $l); + $k{$l->{'id_str'}}++; + } + } + } else { + $my_json_ref = $base_json_ref; + } + } + + # add stream for replies, if requested + if ($mentions) { + my $r = &grabjson($rurl, $fetch_id, 0, + (($last_id) ? 250 + : $fetchwanted || $backload), { + "type" => "reply", + "payload" => "" + }); + push(@streams, $r) + if (defined($r) && + ref($r) eq 'ARRAY' && + scalar(@{ $r })); + } + + # next handle hashtags and tracktags + # failure here does not abort, because search may be down independently + # of the main timeline. + if (!$notrack && scalar(@trackstrings)) { + my $r; + my $k; + my $l = &max((($last_id) ? 100 : + $fetchwanted || $backload), $searchhits); + # temporarily squelch server complaints (see below) + $muffle_server_messages = 1 unless ($verbose); + foreach $k (@trackstrings) { + $r = &grabjson("$queryurl?${k}&rpp=${l}&result_type=recent", + $fetch_id, 1, 0, { + "type" => "search", + "payload" => $k + }); + # depending on the state of the search API, we might be using + # a bogus search ID that is too far back. so if this fails, + # try again with last_id. + if (!defined($r) || ref($r) ne 'ARRAY') { + print $stdout "-- search retry $k attempted with last_id\n" + if ($verbose); + $r = &grabjson("$queryurl?${k}&rpp=${l}&result_type=recent", + $last_id, 1, 0, { + "type" => "search", + "payload" => $k + }); + $dont_roll_back_too_far = 1; + } + # or maybe not even then? + if (!defined($r) || ref($r) ne 'ARRAY') { + print $stdout "-- search retry $k attempted with zero!\n" + if ($verbose); + $r = &grabjson("$queryurl?${k}&rpp=${l}&result_type=recent", + 0, 1, 0, { + "type" => "search", + "payload" => $k + }); + $dont_roll_back_too_far = 1; + } + push(@streams, $r) + if (defined($r) && + ref($r) eq 'ARRAY' && + scalar(@{ $r })); + } + $muffle_server_messages = 0; + } + + # add stream for lists we have on with /set lists, and tag it with + # the list. + if (scalar(@listlist)) { + foreach $k (@listlist) { + my $r = &grabjson(&liurltourl($statusliurl, + $k->[1], $k->[0]), $fetch_id, 0, + (($last_id) ? 250 : $fetchwanted), { + "type" => "list", + "payload" => ($k->[0] ne $whoami) ? + "$k->[0]/$k->[1]" : + "$k->[1]" + }); + push(@streams, $r) + if (defined($r) && ref($r) eq 'ARRAY' && + scalar(@{ $r })); + } + } + + $fetchwanted = 0; # done with that. + # now, streamix all the streams into my_json_ref, discarding duplicates + # a simple hash lookup is no good; it has to be iterative. because of + # that, we might as well just splice it in here and save a sort later. + # the streammix logic is unnecessarily complex, probably. + # remember, the most recent tweets are FIRST. + if (scalar(@streams)) { + my $j; + my $k; + my $l = scalar(@{ $my_json_ref }); + my $m; + my $n; + + foreach $n (@streams) { + SMIX0: foreach $j (@{ $n }) { + my $id = $j->{'id_str'}; # for ease of use + # possible to happen if search tryhard is on + next SMIX0 if ($id < $fetch_id); + + # filter this lot against the id cache + # and any tweets we just filtered. + next SMIX0 if (length($id_cache{$id}) && + $fetch_id); + next SMIX0 if ($filter_next{$id} && + $fetch_id); + + if (!$l) { # degenerate case + push (@{ $my_json_ref }, $j); + $l++; + next SMIX0; + } + + # find the same ID, or one just before, + # and splice in + $m = -1; + SMIX1: for($i=0; $i<$l; $i++) { + next SMIX0 # it's a duplicate + if($my_json_ref->[$i]->{'id_str'} == $id); + if($my_json_ref->[$i]->{'id_str'} < $id) { + $m = $i; + last SMIX1; # got it + } + } + if ($m == -1) { # didn't find + push (@{ $my_json_ref }, $j); + } elsif ($m == 0) { # degenerate case + unshift (@{ $my_json_ref }, $j); + } else { # did find, so splice + splice(@{ $my_json_ref }, $m, 0, + $j); + } + $l++; + } + } + } + %filter_next = (); + + # fetch_id gyration. initially start with last_id, then roll. we + # want to keep a window, though, so we try to pick a sensible value + # that doesn't fetch too much but includes some overlap. we can't + # do computations on the ID itself, because it's "opaque." + $fetch_id = 0 if ($last_id == 0); + ($last_id, $crap) = + &tdisplay($my_json_ref, undef, $relative_last_id); + my $new_fi = (scalar(@{ $my_json_ref })) ? + $my_json_ref->[(scalar(@{ $my_json_ref })-1)]->{'id_str'} : + ''; + # try to widen the window to a "reasonable amount" + $fetch_id = ($fetch_id == 0) ? $last_id : + (length($new_fi) && $new_fi ne $last_id + && $new_fi > $fetch_id) ? $new_fi : + ($relative_last_id > 0 && $relative_last_id ne $last_id && + $relative_last_id > $fetch_id) ? + $relative_last_id : $fetch_id; + + print $stdout +"-- last_id $last_id, fetch_id $fetch_id, rollback $relative_last_id\n". +"-- (@{[ scalar(keys %id_cache) ]} cached)\n" + if ($verbose); + &send_removereadline if ($termrl); + &$conclude; + $wrapseq = 1; + &send_repaint; +} + +# handle (i.e., display) an array of tweets in standard format +sub tdisplay { # used by both synchronous /again and asynchronous refreshes + my $my_json_ref = shift; + my $class = shift; + my $relative_last_id = shift; + my $mini_id = shift; + my $printed = 0; + my $disp_max = &min($print_max, scalar(@{ $my_json_ref })); + my $save_counter = -1; + my $i; + my $j; + + if ($disp_max) { # null list may be valid if we get code 304 + unless ($is_background) { # reset store hash each console + if ($mini_id) { +#TODO +# generalize this at some point instead of hardcoded menu codes +# maybe an ma0-mz9? + $save_counter = $tweet_counter; + $tweet_counter = $mini_split; + for(0..9) { + undef $store_hash{"zz$_"}; + } + }# else { + # $tweet_counter = $back_split; + # %store_hash = (); + #} + } + for($i = $disp_max; $i > 0; $i--) { + my $g = ($i-1); + $j = $my_json_ref->[$g]; + my $id = $j->{'id_str'}; + + next if (!length($j->{'user'}->{'screen_name'})); + if ($filter_c && &$filter_c(&descape($j->{'text'}))) { + $filtered++; + $filter_next{$j->{'id_str'}}++ + if ($is_background); + next; + } + + # assign menu codes and place into caches + $key = (($is_background) ? '' : 'z' ). + substr($alphabet, $tweet_counter/10, 1) . + $tweet_counter % 10; + $tweet_counter = + ($tweet_counter == 259) ? $mini_split : + ($tweet_counter == ($mini_split - 1)) + ? 0 : ($tweet_counter+1); + $j->{'menu_select'} = $key; + $key = lc($key); + + # recover ID cache memory: find the old ID with this + # menu code and remove it, then add the new one + # except if this is the foreground. we don't use this + # in the foreground. + if ($is_background) { + delete $id_cache{$store_hash{$key}->{'id_str'}}; + $id_cache{$id} = $key; + } + + # finally store in menu code cache + $store_hash{$key} = $j; + + sleep 5 while ($suspend_output > 0); + &send_removereadline if ($termrl); + $wrapseq++; + + $printed += scalar(&$handle($j, + ($class || (($id <= $relative_last_id) ? 'again' : + undef)))); + } + } + $tweet_counter = $save_counter if ($save_counter > -1); + sleep 5 while ($suspend_output > 0); + &$exception(6,"*** warning: more tweets than menu codes; truncated\n") + if (scalar(@{ $my_json_ref }) > $print_max); + if (($interactive || $verbose) && !$printed) { + &send_removereadline if ($termrl); + print $stdout "-- sorry, nothing to display.\n"; + $wrapseq = 1; + } + return (&max($my_json_ref->[0]->{'id_str'}, $last_id), $j); +} + +sub dt_tdisplay { + my $my_json_ref = shift; + my $class = shift; + if (defined($my_json_ref) + && ref($my_json_ref) eq 'ARRAY' + && scalar(@{ $my_json_ref })) { + my ($crap, $art) = &tdisplay($my_json_ref, $class); + unless ($timestamp) { + my ($time, $ts1) = &$wraptime( +$my_json_ref->[(&min($print_max,scalar(@{ $my_json_ref }))-1)]->{'created_at'}); + my ($time, $ts2) = &$wraptime($art->{'created_at'}); + print $stdout &wwrap( + "-- update covers $ts1 thru $ts2\n"); + } + &$conclude; + } +} + +# thump for DMs +sub dmrefresh { + my $interactive = shift; + my $sent_dm = shift; + if ($anonymous) { + print $stdout + "-- sorry, you can't read DMs if you're anonymous.\n" + if ($interactive); + return; + } + + # no point in doing this if we can't even get to our own timeline + # (unless user specifically requested it, or our timeline is off) + return if (!$interactive && !$last_id && !$notimeline); # NOT last_dm + + my $my_json_ref = &grabjson((($sent_dm) ? $dmsenturl : $dmurl), + (($sent_dm) ? 0 : $last_dm), 0, $dmfetchwanted); + return if (!defined($my_json_ref) + || ref($my_json_ref) ne 'ARRAY'); + + my $orig_last_dm = $last_dm; + $last_dm = 0 if ($sent_dm); + + $dmfetchwanted = 0; + my $printed = 0; + my $max = 0; + my $disp_max = &min($print_max, scalar(@{ $my_json_ref })); + my $i; + my $g; + my $key; + + if ($disp_max) { # an empty list can be valid + if ($dm_first_time) { + sleep 5 while ($suspend_output > 0); + &send_removereadline if ($termrl); + print $stdout + "-- checking for most recent direct messages:\n"; + $disp_max = 2; + $interactive = 1; + } + for($i = $disp_max; $i > 0; $i--) { + $g = ($i-1); + my $j = $my_json_ref->[$g]; + next if (!$sent_dm && $j->{'id_str'} <= $last_dm); + next if (!length($j->{'sender'}->{'screen_name'}) || + !length($j->{'recipient'}->{'screen_name'})); + + $key = substr($alphabet, $dm_counter/10, 1) . + $dm_counter % 10; + $dm_counter = + ($dm_counter == 259) ? 0 : + ($dm_counter+1); + $j->{'menu_select'} = $key; + $dm_store_hash{lc($key)} = $j; + + sleep 5 while ($suspend_output > 0); + &send_removereadline if ($termrl); + $wrapseq++; + + $printed += scalar(&$dmhandle($j)); + } + $max = $my_json_ref->[0]->{'id_str'}; + } + sleep 5 while ($suspend_output > 0); + if (($interactive || $verbose) && !$printed && !$dm_first_time) { + &send_removereadline if ($termrl); + print $stdout (($sent_dm) + ? "-- you haven't sent anything yet.\n" + : "-- sorry, no new direct messages.\n"); + $wrapseq = 1; + } + $last_dm = ($sent_dm) ? $orig_last_dm + : &max($last_dm, $max); + $dm_first_time = 0 if ($last_dm || !scalar(@{ $my_json_ref })); + print $stdout "-- dm bookmark is $last_dm.\n" if ($verbose); + &$dmconclude; + &send_repaint; +} + +# post an update +# this is a general API function that handles status updates and sending DMs. +sub updatest { + my $string = shift; + my $interactive = shift; + my $in_reply_to = shift; + my $user_name_dm = shift; + my $rt_id = shift; # even if this is set, string should also be set. + my $urle = ''; + my $i; + my $subpid; + my $istring; + + my $verb = (length($user_name_dm)) ? "DM $user_name_dm" : + ($rt_id) ? 'RE-tweet' : + 'tweet'; + + if ($anonymous) { + print $stdout + "-- sorry, you can't $verb if you're anonymous.\n" + if ($interactive); + return 99; + } + + # "the pastebrake" + if (!$slowpost && !$verify && !$script) { + if ((time() - $postbreak_time) < 5) { + $postbreak_count++; + if ($postbreak_count == 3) { + print $stdout + "-- you're posting pretty fast. did you mean to do that?\n". + "-- waiting three seconds before taking the next set of tweets\n". + "-- hit CTRL-C NOW! to kill TTYtter if you accidentally pasted in this window\n"; + sleep 3; + $postbreak_count = 0; + } + } else { + $postbreak_count = 0; + } + $postbreak_time = time(); + } + + my $payload = (length($user_name_dm)) ? 'text' : 'status'; + $string = &$prepost($string) unless ($user_name_dm || $rt_id); + + # YES, you *can* verify and slowpost. I thought about this and I + # think I want to allow it. + if ($verify && !$status) { + my $answer; + + print $stdout + &wwrap("-- verify you want to $verb: \"$string\"\n"); + $answer = &linein( + "-- send to server? (only y or Y is affirmative):"); + if ($answer ne 'y') { + print $stdout "-- ok, NOT sent to server.\n"; + return 97; + } + } + + unless ($rt_id) { + $urle = ''; + foreach $i (unpack("${pack_magic}C*", $string)) { + my $k = chr($i); + if ($k =~ /[-._~a-zA-Z0-9]/) { + $urle .= $k; + } else { + $k = sprintf("%02X", $i); + $urle .= "%$k"; + } + } + } + + $user_name_dm = (length($user_name_dm)) ? + "&user=$user_name_dm" : ''; + + my $i = ''; + $i .= "source=TTYtter&" if ($authtype eq 'basic'); + $i .= "in_reply_to_status_id=${in_reply_to}&" if ($in_reply_to > 0); + if (!$rt_id && defined $lat && defined $long && $location) { + print $stdout "-- using lat/long: ($lat, $long)\n"; + $i .= "lat=${lat}&long=${long}&"; + } elsif ((defined $lat || defined $long) && $location && !$rt_id) { + print $stdout + "-- warning: incomplete location ($lat, $long) ignored\n"; + } + $i .= "${payload}=${urle}${user_name_dm}" unless ($rt_id); + $i .= "id=$rt_id" if ($rt_id); + $slowpost += 0; if ($slowpost && !$script && !$status && !$silent) { + if($pid = open(SLOWPOST, '-|')) { + print $stdout &wwrap( + "-- waiting $slowpost seconds to $verb, ^C cancels: \"$string\"\n"); + close(SLOWPOST); # this should wait for us + if ($? > 256) { + print $stdout + "\n-- not sent, cancelled by user\n"; + return 97; + } + print $stdout "-- sending to server\n"; + } else { + $in_backticks = 1; # defeat END sub + $SIG{'BREAK'} = $SIG{'INT'} = sub { + exit 254; + }; + sleep $slowpost; + exit 0; + } + } + my $return = &backticks($baseagent, '/dev/null', undef, + (length($user_name_dm)) ? $dmupdate : + ($rt_id) ? "$rturl/${rt_id}.json" : + $update, $i, 0, @wend); + print $stdout "-- return --\n$return\n-- return --\n" + if ($superverbose); + if ($? > 0) { + $x = $? >> 8; + print $stdout <<"EOF" if ($interactive); +${MAGENTA}*** warning: connect timeout or no confirmation received ($x) +*** to attempt a resend, type %%${OFF} +EOF + return $?; + } + my $ec; + if ($ec = &is_json_error($return)) { + print $stdout <<"EOF" if ($interactive); +${MAGENTA}*** warning: server error message received +*** "$ec"${OFF} +EOF + return 98; + } + if ($ec = &is_fail_whale($return) || + $return =~ /^\[?\]?<!DOCTYPE\s+html/i || + $return =~ /^(Status:\s*)?50[0-9]\s/ || + $return =~ /^<html>/i || + $return =~ /^<\??xml\s+/) { + print $stdout <<"EOF" if ($interactive); +${MAGENTA}*** warning: Twitter Fail Whale${OFF} +EOF + return 98; + } + $lastpostid = &parsejson($return)->{'id_str'}; + unless ($user_name_dm || $rt_id) { + $lasttwit = $string; + &$postpost($string); + } + return 0; +} + +# this dispatch routine replaces the common logic of deletest, deletedm, +# follow, leave and the favourites system. +# this is a modified, abridged version of &updatest. +sub central_cd_dispatch { + my ($payload, $interactive, $update) = (@_); + my $return = &backticks($baseagent, '/dev/null', undef, + $update, $payload, 0, @wend); + print $stdout "-- return --\n$return\n-- return --\n" + if ($superverbose); + if ($? > 0) { + $x = $? >> 8; + print $stdout <<"EOF" if ($interactive); +${MAGENTA}*** warning: connect timeout or no confirmation received ($x) +*** to attempt again, type %%${OFF} +EOF + return ($?, ''); + } + my $ec; + if ($ec = &is_json_error($return)) { + print $stdout <<"EOF" if ($interactive); +${MAGENTA}*** warning: server error message received +*** "$ec"${OFF} +EOF + return (98, $return); + } + return (0, $return); +} + +# the following functions may be user-exposed in a future version of +# TTYtter, but are officially still "private interfaces." +# delete a status +sub deletest { + my $id = shift; + my $interactive = shift; + + my $update = "${delurl}/${id}.json"; + my ($en, $em) = ¢ral_cd_dispatch("id=$id", $interactive, $update); + print $stdout "-- tweet id #${id} has been removed\n" + if ($interactive && !$en); + print $stdout "*** (was the tweet already deleted?)\n" + if ($interactive && $en); + return 0; +} + +# delete a DM +sub deletedm { + my $id = shift; + my $interactive = shift; + + my $update = "${dmdelurl}/${id}.json"; + my ($en, $em) = ¢ral_cd_dispatch("id=$id", $interactive, $update); + print $stdout "-- DM id #${id} has been removed\n" + if ($interactive && !$en); + print $stdout "*** (was the DM already deleted?)\n" + if ($interactive && $en); + return 0; +} + +# create or destroy a favourite +sub cordfav { + my $id = shift; + my $interactive = shift; + my $basefav = shift; + my $text = shift; + my $verb = shift; + + my $update = "${basefav}/${id}.json"; + my ($en, $em) = ¢ral_cd_dispatch("id=$id", $interactive, $update); + print $stdout "-- favourite $verb for tweet id #${id}: \"$text\"\n" + if ($interactive && !$en); + print $stdout "*** (was the favourite already ${verb}?)\n" + if ($interactive && $en); + return 0; +} + +# follow or unfollow a user +sub foruuser { + my $uname = shift; + my $interactive = shift; + my $basef = shift; + my $verb = shift; + + my $update = "${basef}/${uname}.json"; + my ($en, $em) = ¢ral_cd_dispatch("screen_name=$uname", + $interactive, $update); + print $stdout "-- ok, you have $verb following user $uname.\n" + if ($interactive && !$en); + return 0; +} + +# block or unblock a user +sub boruuser { + my $uname = shift; + my $interactive = shift; + my $basef = shift; + my $verb = shift; + + my ($en, $em) = ¢ral_cd_dispatch("screen_name=$uname", + $interactive, $basef); + print $stdout "-- ok, you have $verb blocking user $uname.\n" + if ($interactive && !$en); + return 0; +} + +#### TTYtter internal API utility functions #### +# ... which your API *can* call + +# gets and returns the contents of a URL (optionally pass a POST body) +sub graburl { + my $resource = shift; + my $data = shift; + + return &backticks($baseagent, + '/dev/null', undef, $resource, $data, + 1, @wind); +} + +# format a tweet based on user options +sub standardtweet { + my $ref = shift; + my $nocolour = shift; + + my $sn = &descape($ref->{'user'}->{'screen_name'}); + my $tweet = &descape($ref->{'text'}); + my $colour; + my $g; + my $h; + + # wordwrap really ruins our day here, thanks a lot, @augmentedfourth + # have to insinuate the ansi sequences after the string is wordwrapped + + $g = $colour = ${'CC' . scalar(&$tweettype($ref, $sn, $tweet)) } + unless ($nocolour); + $colour = $OFF . $colour + unless ($nocolour); + + # prepend screen name "badges" + $sn = "\@$sn" if ($ref->{'in_reply_to_status_id_str'} > 0); + $sn = "+$sn" if ($ref->{'user'}->{'geo_enabled'} eq 'true' && + $ref->{'geo'}->{'coordinates'}->[0] ne 'undef' && + $ref->{'geo'}->{'coordinates'}->[1] ne 'undef'); + $sn = "%$sn" if (length($ref->{'retweeted_status'}->{'id_str'})); + $sn = "*$sn" if ($ref->{'source'} =~ /TTYtter/ && $ttytteristas); + # prepend list information, if this tweet originated from a list + $sn = "($ref->{'tag'}->{'payload'})$sn" + if (length($ref->{'tag'}->{'payload'}) && + $ref->{'tag'}->{'type'} eq 'list'); + $tweet = "<$sn> $tweet"; + # twitter doesn't always do this right. + $h = $ref->{'retweet_count'}; $h += 0; $h = "${h}+" if ($h >= 100); + # twitter doesn't always handle single retweets right. good f'n grief. + $tweet = "(x${h}) $tweet" if ($h > 1 && !$nonewrts); + # br3nda's modified timestamp patch + if ($timestamp) { + my ($time, $ts) = &$wraptime($ref->{'created_at'}); + $tweet = "[$ts] $tweet"; + } + + # pull it all together + $tweet = &wwrap($tweet, ($wrapseq <= 1) ? ((&$prompt(1))[1]) : 0) + if ($wrap); # remember to account for prompt length on #1 + $tweet =~ s/^([^<]*)<([^>]+)>/${g}\1<${EM}\2${colour}>/ + unless ($nocolour); + $tweet =~ s/\n*$//; + $tweet .= ($nocolour) ? "\n" : "$OFF\n"; + + # highlight anything that we have in track + if(scalar(@tracktags)) { # I'm paranoid + foreach $h (@tracktags) { + $h =~ s/^"//; $h =~ s/"$//; # just in case +$tweet =~ s/(^|[^a-zA-Z0-9])($h)([^a-zA-Z0-9]|$)/\1${EM}\2${colour}\3/ig + unless ($nocolour); + } + } + + # smb's underline/bold patch goes on last (modified for lists) + unless ($nocolour) { + # only do this after the < > portion. + my $k = index($tweet, ">"); + my $botsub = substr($tweet, $k); + my $topsub = substr($tweet, 0, $k); + $botsub =~ +s/(^|[^a-zA-Z0-9_])\@([a-zA-Z0-9_\-\/]+)/\1\@${UNDER}\2${colour}/g; + $tweet = $topsub . $botsub; + } + + return $tweet; +} + +# format a DM based on standard user options +sub standarddm { + my $ref = shift; + my $nocolour = shift; + + my ($time, $ts) = &$wraptime($ref->{'created_at'}); + my $text = &descape($ref->{'text'}); + my $sns = &descape($ref->{'sender'}->{'screen_name'}); + if ($sns eq $whoami) { + $sns = "->" . &descape($ref->{'recipient'}->{'screen_name'}); + } + my $g = &wwrap("[DM d$ref->{'menu_select'}]". + "[$sns/$ts] $text", ($wrapseq <= 1) ? ((&$prompt(1))[1]) : 0); + + $g =~ s/^\[DM ([^\/]+)\//${CCdm}[DM ${EM}\1${OFF}${CCdm}\// + unless ($nocolour); + $g =~ s/\n*$//; + $g .= ($nocolour) ? "\n" : "$OFF\n"; + $g =~ s/(^|[^a-zA-Z0-9_])\@(\w+)/\1\@${UNDER}\2${OFF}${CCdm}/g + unless ($nocolour); + return $g; +} + +# for future expansion: this is the declared API callable method +# for executing a command as if the console had typed it. +sub ucommand { + die("** can't call &ucommand during multi-module loading.\n") + if ($multi_module_mode == -1); + &prinput(@_); +} + +# your application can also call &grabjson to get a hashref +# corresponding to parsed JSON from an arbitrary resource. +# see that function later on. + + +#### DEFAULT TTYtter INTERNAL API METHODS #### +# don't change these here. instead, use -exts=yourlibrary.pl and set there. +# note that these are all anonymous subroutine references. +# anything you don't define is overwritten by the defaults. +# it's better'n'superclasses. +# NOTE: defaultaddaction, defaultmain and defaultprompt +# are all defined in the "console" section above for +# clarity. + +# this first set are the multi-module aware ones. + +# the standard iterator for multi-module methods +sub multi_module_dispatch { + my $default = shift; + my $dispatch_chain = shift; + my $rv_handler = shift; + my @args = @_; + + local $dispatch_ref; # on purpose; get_key/set_key may need it + # $*_call_default is a global + $did_call_default = 0; + $this_call_default = 0; + $multi_module_context = 0; + + if ($rv_handler == 0) { + $rv_handler = sub { + return 0; + }; + } + + # fall through to default if no dispatch chain + if (!scalar(@{ $dispatch_chain })) { + return &$default(@args); + } + foreach $dispatch_ref (@{ $dispatch_chain }) { + # each reference has the code, and the file that specified it. + # set up a multi-module context and run that function. if the + # default ever gets called, we log it to tell the multi-module + # handler to call the default at the end. + + my $rv; + my $irv; + my $caller = (caller(1))[3]; + $caller =~ s/^main::multi//; + + $multi_module_context = 1; # defaults then know to defer + $this_call_default = 0; + $store = $master_store->{ $dispatch_ref->[0] }; + print "-- calling \$$caller in $dispatch_ref->[0]\n" + if ($verbose); + my $code_ref = $dispatch_ref->[1]; + $rv = &$rv_handler(@irv = &$code_ref(@args)); + $multi_module_context = 0; + if ($rv & 4) { + # rv_handler indicating to call default and halt + # if it was called. + return &$default(@args) if ($did_call_default); + } + if ($rv & 2) { + # rv_handler indicating to make new @args from @irv + @args = @irv; + } + if ($rv & 1) { + # rv_handler indicating to halt early. do so. + return (wantarray) ? @irv : $irv[0]; + } + } + $multi_module_context = 0; + return &$default(@args) if ($did_call_default); + return (wantarray) ? @irv : $irv[0]; +} + +# these are the stubs that call the dispatcher. +sub multiaddaction { + &multi_module_dispatch(\&defaultaddaction, \@m_addaction, sub{ + # return immediately on the first extension to accept + return (shift>0); + }, @_); +} +sub multiconclude { + &multi_module_dispatch(\&defaultconclude, \@m_conclude, 0, @_); +} +sub multidmconclude { + &multi_module_dispatch(\&defaultdmconclude, \@m_dmconclude, 0, @_); +} +#handlr +sub multidmhandle { + &multi_module_dispatch(\&defaultdmhandle, \@m_dmhandle, sub { + my $rv = shift; + + # skip default calls. + return 0 if ($this_call_default); + + # if not a default call, and the DM was refused for + # processing by this extension, then the DM is now + # suppressed. do not call any other extensions after this. + # even if it ends in suppression, we still call the default + # if it was ever called before. + return 5 if ($rv == 0); + + # if accepted in any manner, keep calling. + return 0; + }, @_); +} +sub multiexception { + # this is a secret option for people who want to suppress errors. + if ($exception_is_maskable) { + &multi_module_dispatch(\&defaultexception, \@m_exception, sub { + my $rv = shift; + + # same logic as handle/dmhandle, except return -1- + # to mask from subsequent extensions. + return 0 if ($this_call_default); + return 5 if ($rv); + return 0; + }, @_); + } else { + &multi_module_dispatch( + \&defaultexception, \@m_exception, 0, @_); + } +} +sub multishutdown { + return if ($shutdown_already_called++); + &multi_module_dispatch(\&defaultshutdown, \@m_shutdown, 0, @_); +} + +sub multiuserhandle { + &multi_module_dispatch(\&defaultuserhandle, \@m_userhandle, sub{ + # skip default calls. + return 0 if ($this_call_default); + + # return immediately on the first extension to accept + return (shift>0); + }, @_); +} +sub multilisthandle { + &multi_module_dispatch(\&defaultlisthandle, \@m_listhandle, sub{ + # skip default calls. + return 0 if ($this_call_default); + + # return immediately on the first extension to accept + return (shift>0); + }, @_); +} +sub multihandle { + &multi_module_dispatch(\&defaulthandle, \@m_handle, sub { + my $rv = shift; + + # skip default calls. + return 0 if ($this_call_default); + + # if not a default call, and the tweet was refused for + # processing by this extension, then the tweet is now + # suppressed. do not call any other extensions after this. + # even if it ends in suppression, we still call the default + # if it was ever called before. + return 5 if ($rv==0); + + # if accepted in any manner, keep calling. + return 0; + }, @_); +} +sub multiheartbeat { + &multi_module_dispatch(\&defaultheartbeat, \@m_heartbeat, 0, @_); +} +sub multiprecommand { + &multi_module_dispatch(\&defaultprecommand, \@m_precommand, sub { + return 2; # feed subsequent chains the result. + }, @_); +} +sub multiprepost { + &multi_module_dispatch(\&defaultprepost, \@m_prepost, sub { + return 2; # feed subsequent chains the result. + }, @_); +} +sub multipostpost { + &multi_module_dispatch(\&defaultpostpost, \@m_postpost, 0, @_); +} +sub multitweettype { + &multi_module_dispatch(\&defaulttweettype, \@m_tweettype, sub { + # if this module DID NOT call default, exit now. + return (!$this_call_default); + }, @_); +} + +sub flag_default_call { $this_call_default++; $did_call_default++; } + +# now the actual default methods + +sub defaultexception { + (&flag_default_call, return) if ($multi_module_context); + my $msg_code = shift; + return if ($msg_code == 2 && $muffle_server_messages); + my $message = "@_"; + $message =~ s/\n*$//sg; + if ($timestamp) { + my ($time, $ts) = &$wraptime(scalar(localtime)); + $message = "[$ts] $message"; + $message =~ s/\n/\n[$ts] /sg; + } + &send_removereadline if ($termrl); + $wrapseq = 1; + print $stdout "${MAGENTA}${message}${OFF}\n"; + &send_repaint; + $laststatus = 1; +} +sub defaultshutdown { + (&flag_default_call, return) if ($multi_module_context); +} +sub defaultlisthandle { + (&flag_default_call, return) if ($multi_module_context); + my $list_ref = shift; + + print $streamout "*** for future expansion ***\n"; + + return 1; +} +sub defaulthandle { + (&flag_default_call, return) if ($multi_module_context); + my $tweet_ref = shift; + my $class = shift; + my $dclass = ($verbose) ? "{$class,$tweet_ref->{'id_str'}} " : ''; + my $sn = &descape($tweet_ref->{'user'}->{'screen_name'}); + my $tweet = &descape($tweet_ref->{'text'}); + my $stweet = &standardtweet($tweet_ref); + my $menu_select = $tweet_ref->{'menu_select'}; + + $menu_select = (length($menu_select) && !$script) + ? (($menu_select =~ /^z/) ? + "${EM}${menu_select}>${OFF} " : + "${menu_select}> ") + : ''; + + print $streamout $menu_select . $dclass . $stweet; + &sendnotifies($tweet_ref, $class); + return 1; +} +sub defaultuserhandle { + (&flag_default_call, return) if ($multi_module_context); + + my $user_ref = shift; + &userline($user_ref, $streamout); + my $desc = &strim(&descape($user_ref->{'description'})); + my $klen = ($wrap || 79) - 9; + $klen = 10 if ($klen < 0); + $desc = substr($desc, 0, $klen)."..." if (length($desc) > $klen); + print $streamout (' "' . $desc . '"' . "\n") if (length($desc)); + return 1; +} +sub userline { # used by both $userhandle and /whois + my $my_json_ref = shift; + my $fh = shift; + + my $verified = + ($my_json_ref->{'verified'} eq 'true') ? + "${EM}(Verified)${OFF} " : ''; + my $protected = + ($my_json_ref->{'protected'} eq 'true') ? + "${EM}(Protected)${OFF} " : ''; + print $fh <<"EOF"; +${CCprompt}@{[ &descape($my_json_ref->{'name'}) ]}${OFF} (@{[ &descape($my_json_ref->{'screen_name'}) ]}) (f:$my_json_ref->{'friends_count'}/$my_json_ref->{'followers_count'}) (u:$my_json_ref->{'statuses_count'}) ${verified}${protected} +EOF + return; +} +sub sendnotifies { # this is a default subroutine of a sort, right? + my $tweet_ref = shift; + my $class = shift; + + my $sn = &descape($tweet_ref->{'user'}->{'screen_name'}); + my $tweet = &descape($tweet_ref->{'text'}); + + unless (length($class) || !$last_id) { # interactive? first time? + $class = scalar(&$tweettype($tweet_ref, $sn, $tweet)); + ¬ifytype_dispatch($class, + &standardtweet($tweet_ref, 1), $tweet_ref) + if ($notify_list{$class}); + } +} + +sub defaulttweettype { + (&flag_default_call, return) if ($multi_module_context); + my $ref = shift; + my $sn = shift; + my $tweet = shift; + + # br3nda's and smb's modified colour patch + unless ($anonymous) { + if ($sn eq $whoami) { + # if it's me speaking, colour the line yellow + return 'me'; + } elsif ($tweet =~ /\@$whoami(\b|$)/i) { + # if I'm in the tweet, colour red + return 'reply'; + } + } + if ($ref->{'class'} eq 'search') { # anonymous allows this too + # if this is a search result, colour cyan + return 'search'; + } + if ($ref->{'tag'}->{'type'} eq 'list') { # anonymous allows this too + return 'list'; + } + return 'default'; +} + +sub defaultconclude { + (&flag_default_call, return) if ($multi_module_context); + if ($filtered && $filter_attribs{'count'}) { + print $stdout "-- (filtered $filtered tweets)\n"; + $filtered = 0; + } +} + +sub defaultdmhandle { + (&flag_default_call, return) if ($multi_module_context); + my $dm_ref = shift; + print $streamout &standarddm($dm_ref); + &senddmnotifies($dm_ref); + return 1; +} +sub senddmnotifies { + my $dm_ref = shift; + ¬ifytype_dispatch('DM', &standarddm($dm_ref, 1), $dm_ref) + if ($notify_list{'dm'} && $last_dm); +} + +sub defaultdmconclude { + (&flag_default_call, return) if ($multi_module_context); +} + +sub defaultheartbeat { + (&flag_default_call, return) if ($multi_module_context); +} + +# not much sense to multi-module protect these. +sub defaultprecommand { return ("@_"); } +sub defaultprepost { return ("@_"); } + +sub defaultpostpost { + (&flag_default_call, return) if ($multi_module_context); + my $line = shift; + return if (!$termrl); + + # populate %readline_completion if readline is on + while($line =~ s/^\@(\w+)\s+//) { + $readline_completion{'@'.lc($1)}++; + } + if ($line =~ /^[dD]\s+(\w+)\s+/) { + $readline_completion{'@'.lc($1)}++; + } +} + +sub defaultautocompletion { + my ($text, $line, $start) = (@_); + my $qmtext = quotemeta($text); + my @proband; + my @rlkeys; + + # handle / completion + if ($start == 0 && $text =~ m#^/#) { + return sort grep(/^$qmtext/i, '/history', + '/print', '/quit', '/bye', '/again', + '/wagain', '/whois', '/thump', '/dm', + '/refresh', '/dmagain', '/set', '/help', + '/reply', '/url', '/thread', '/retweet', + '/replies', '/ruler', '/exit', '/me', '/vcheck', + '/oretweet', '/eretweet', '/fretweet', '/liston', + '/listoff', '/dmsent', '/rtsof', '/rtsofme', + '/lists', '/withlist', '/add', '/padd', '/push', + '/pop', '/followers', '/friends', '/lfollow', + '/lleave', '/listfollowers', '/listfriends', + '/unset', '/verbose', '/short', '/follow', '/unfollow', + '/doesfollow', '/search', '/tron', '/troff', + '/delete', '/deletelast', '/dump', + '/track', '/trends', '/block', '/unblock', + '/fave', '/faves', '/unfave', '/eval'); + } + @rlkeys = keys(%readline_completion); + + # handle @ completion. this works slightly weird because + # readline hands us the string WITHOUT the @, so we have to + # test somewhat blindly. this works even if a future readline + # DOES give us the word with @. also handles D, /wa, /wagain, + # /a, /again, etc. + if (($line =~ m#^(D|/wa|/wagain|/a|/again) #i) || + ($start == 1 && substr($line, 0, 1) eq '@') || + # this code is needed to prevent inline @ from flipping out + ($start >= 1 && substr($line, ($start-2), 2) eq ' @')) { + @proband = grep(/^\@$qmtext/i, @rlkeys); + if (scalar(@proband)) { + @proband = map { s/^\@//;$_ } @proband; + return @proband; + } + } + # definites that are left over, including @ if it were included + if(scalar(@proband = grep(/^$qmtext/i, @rlkeys))) { + return @proband; + } + + # heuristics + # URL completion (this doesn't always work of course) + if ($text =~ m#https?://#) { + return (&urlshorten($text) || $text); + } + + # "I got nothing." + return (); +} + +#### built-in notification routines #### + +# growl for Mac OS X +sub notifier_growl { + my $class = shift; + my $text = shift; + my $ref = shift; # not used in this version + + if (!defined($class) || !length($notify_tool_path)) { + # we are being asked to initialize + $notify_tool_path = &wherecheck("trying to find growlnotify", + "growlnotify", +"growlnotify must be installed to use growl notifications. check your\n" . + "documentation for how to do this.\n") + unless ($notify_tool_path); + if (!defined($class)) { + return 1 if ($script || $notifyquiet); + $class = 'Growl support activated'; + $text = +'You can configure notifications for TTYtter in the Growl preference pane.'; + } + } + # handle this in the background for faster performance. + # to avoid problems with SIGCHLD, we fork ourselves twice (mmm!), + # leaving an orphan which init should grab (we need SIGCHLD for + # proper backticks, so it can't be IGNOREd). + my $gchild; + if ($gchild = fork()) { + # the parent harvests the child, which will die immediately. + waitpid($gchild, 0); + return 1; + } elsif (!defined ($gchild)) { + print $stdout "warning: failed growl fork: $!\n"; + return 1; + } + # this is the child. spawn, then exit and abandon our own child, + # which init will reap. the problem with teen pregnancy is mounting. + $in_backticks = 1; + my $hchild; + if ($hchild = fork()) { + exit; + } elsif (!defined ($hchild)) { + print $stdout "warning: failed growl fork: $!\n"; + exit; + } + # this is the subchild, which is abandoned at a fire sta^W^W^Winit. + open(GROWL, "|$notify_tool_path -n 'TTYtter' 'TTYtter: $class'"); + binmode(GROWL, ":utf8") unless ($seven); + print GROWL $text; + close(GROWL); + exit; +} + +# libnotify for {Linux,whatevs} +# this is EXPERIMENTAL, and requires this patch to notify-send: +# http://www.floodgap.com/software/ttytter/libnotifypatch.txt +# why it has not already been applied is fricking beyond me, it makes +# sense. would YOU want arbitrary characters on the command line +# separated only from overwriting your home directory by a quoting routine? +sub notifier_libnotify { + my $class = shift; + my $text = shift; + my $ref = shift; # not used in this version + + if (!defined($class) || !defined($notify_tool_path)) { + # we are being asked to initialize + $notify_tool_path = &wherecheck("trying to find notify-send", + "notify-send", +"notify-send must be installed to use libnotify, and it must be modified\n". +"for standard input. see the documentation for how to do this.\n") + unless ($notify_tool_path); + if (!defined($class)) { + return 1 if ($script || $notifyquiet); + $class = 'libnotify support activated'; + $text = +'Congratulations, your notify-send is correctly configured for TTYtter.'; + } + } + # figure out the time to display based on length of tweet + my $t = 1000+50*length($text); # about 150-180wpm read speed + open(NOTIFYSEND, + "|$notify_tool_path -t $t -f - 'TTYtter: $class'"); + binmode(NOTIFYSEND, ":utf8") unless ($seven); + print NOTIFYSEND $text; + close(NOTIFYSEND); + return 1; +} + +#### IPC routines for communicating between the foreground + background #### + +# this is the central routine that takes a rolling tweet code, figures +# out where that tweet is, and returns something approximating a tweet +# structure (or the actual tweet structure itself if it can). +sub get_tweet { + my $code = lc(shift); + return undef if ($code !~ /^z?[a-z][0-9]$/); + my $source = ($code =~ /^z/) ? 1 : 0; + my $k = ''; + my $l = ''; + my $w = {'user' => {}}; + + if ($is_background) { + if ($source == 1) { # foreground only + return undef; + } + return $store_hash{$code}; + } + return $store_hash{$code} if ($source); # foreground c/foreground twt + + print $stdout "-- querying background: $code\n" if ($verbose); + kill 31, $child if ($child); + print C "pipet $code ----------\n"; + while(length($k) < 1024) { + sysread(W, $l, 1024); + $k .= $l; + } + return undef if ($k !~ /[^\s]/); + $k =~ s/\s+$//; # remove trailing spaces + print $stdout "-- background store fetch: $k\n" if ($verbose); + ($w->{'menu_select'}, $w->{'id_str'}, $w->{'in_reply_to_status_id_str'}, + $w->{'retweeted_status'}->{'id_str'}, + $w->{'user'}->{'geo_enabled'}, + $w->{'geo'}->{'coordinates'}->[0], + $w->{'geo'}->{'coordinates'}->[1], + $w->{'tag'}->{'type'}, + $w->{'tag'}->{'payload'}, + $w->{'retweet_count'}, + $w->{'user'}->{'screen_name'}, $w->{'created_at'}, + $l) = split(/\s/, $k, 13); + ($w->{'source'}, $k) = split(/\|/, $l, 2); + $w->{'text'} = pack("H*", $k); + $w->{'tag'}->{'payload'} = pack("H*", $w->{'tag'}->{'payload'}); + return undef if (!length($w->{'text'})); # not possible + $w->{'created_at'} =~ s/_/ /g; + return $w; +} + +# this is the analogous function for a rolling DM code. it is somewhat +# simpler as DM codes are always rolling and have no foreground store +# currently, so it always executes a background request. +sub get_dm { + my $code = lc(shift); + my $k = ''; + my $l = ''; + my $w = {'sender' => {}}; + + return undef if (length($code) != 3 || $code !~ s/^d// || + $code !~ /^[a-z][0-9]$/); + kill 31, $child if ($child); # prime pipe + print C "piped $code ----------\n"; # internally two alphanum, recall + while(length($k) < 1024) { + sysread(W, $l, 1024); + $k .= $l; + } + return undef if ($k !~ /[^\s]/); + $k =~ s/\s+$//; # remove trailing spaces + print $stdout "-- background store fetch: $k\n" if ($verbose); + ($w->{'menu_select'}, $w->{'id_str'}, + $w->{'sender'}->{'screen_name'}, $w->{'created_at'}, + $l) = split(/\s/, $k, 5); + $w->{'text'} = pack("H*", $l); + return undef if (!length($w->{'text'})); # not possible + $w->{'created_at'} =~ s/_/ /g; + return $w; +} + +# this function requests a $store key from the background. it only works +# if foreground. +sub getbackgroundkey { + if ($is_background) { + print $stdout "*** can't call getbackgroundkey from background\n"; + return undef; + } + my $key = shift; + my $l; + my $k; + print C substr("ki $key ---------------------", 0, 19)."\n"; + my $ref = (length($dispatch_ref->[0])) ? ($dispatch_ref->[0]) : + "DEFAULT"; + print C substr(unpack("${pack_magic}H*", $ref).$space_pad, 0, 1024); + while(length($k) < 1024) { + sysread(W, $l, 1024); + $k .= $l; + } + $k =~ s/[^0-9a-fA-F]//g; + print $stdout "-- background store fetch: $k\n" if ($verbose); + return pack("H*", $k); +} + +# this function sends a $store key to the background. it only works if +# foreground. +sub sendbackgroundkey { + if ($is_background) { + print $stdout "*** can't call sendbackgroundkey from background\n"; + return; + } + my $key = shift; + my $value = shift; + if (ref($value)) { + print $stdout "*** send_key only supported for scalars\n"; + return; + } + if (!length($value)) { + print C substr("kn $key ---------------------", 0, 19)."\n"; + } else { + print C substr("ko $key ---------------------", 0, 19)."\n"; + } + my $ref = (length($dispatch_ref->[0])) ? ($dispatch_ref->[0]) : + "DEFAULT"; + print C substr(unpack("${pack_magic}H*", $ref).$space_pad, 0, 1024); + return if (!length($value)); + print C substr(unpack("${pack_magic}H*", $value).$space_pad, 0, 1024); +} + +sub thump { print C "update-------------\n"; &sync_semaphore; } +sub dmthump { print C "dmthump------------\n"; &sync_semaphore; } + +sub sync_n_quit { + if ($child) { + print $stdout "waiting for child ...\n" unless ($silent); + print C "sync---------------\n"; + waitpid $child, 0; + $child = 0; + print $stdout "exiting.\n" unless ($silent); + exit ($? >> 8); + } + exit; +} + +# setter for internal variables, with all the needed side effects for those +# variables that are programmed to trigger internal actions when changed. +sub setvariable { + my $key = shift; + my $value = shift; + my $interactive = 0+shift; + + $value =~ s/^\s+//; + $value =~ s/\s+$//; # mostly to avoid problems with /(p)add + + if ($key eq 'script') { # this can never be changed by this routine + print $stdout "*** script may only be changed on init\n"; + return 1; + } + if ($key eq 'tquery' && $value eq '0') { # undo tqueries + $tquery = undef; + $key = 'track'; + $value = $track; # falls thru to sync + &tracktags_makearray; + } + if ($opts_can_set{$key} || + # we CAN set read-only variables during initialization + ($multi_module_mode == -1 && $valid{$key})) { + if (length($value) > 1023) { + # can't transmit this in a packet + print $stdout "*** value too long\n"; + return 1; + } elsif ($opts_boolean{$key} && $value ne '0' && + $value ne '1') { + print $stdout "*** 0|1 only (boolean): $key\n"; + return 1; + } elsif ($opts_urls{$key} && + $value !~ m#^(http|https|gopher)://#) { + print $stdout "*** must be valid URL: $key\n"; + return 1; + } else { + KEYAGAIN: $$key = $value; + print $stdout "*** changed: $key => $$key\n" + if ($interactive || $verbose); + + # handle special values + &generate_ansi if ($key eq 'ansi' || + $key =~ /^colour/); + &generate_shortdomain if ($key eq 'shorturl'); + &tracktags_makearray if ($key eq 'track'); + &filter_compile if ($key eq 'filter'); + ¬ify_compile if ($key eq 'notifies'); + &list_compile if ($key eq 'lists'); + + # transmit to background process sync-ed values + if ($opts_sync{$key}) { + &synckey($key, $value, $interactive); + } + if ($key eq 'superverbose') { + if ($value eq '0') { + $key = 'verbose'; + $value = $supreturnto; + goto KEYAGAIN; + } + $supreturnto = $verbose; + } + } + # virtual keys + } elsif ($key eq 'tquery') { + my $ivalue = &tracktags_tqueryurlify($value); + if (length($ivalue) > 139) { + print $stdout + "*** custom query is too long (encoded: $ivalue)\n"; + return 1; + } else { + $tquery = $value; + &synckey($key, $ivalue, $interactive); + } + } elsif ($valid{$key}) { + print $stdout + "*** read-only, must change on command line: $key\n"; + return 1; + } else { + print $stdout + "*** not a valid option or setting: $key\n"; + return 1; + } + return 0; +} +sub synckey { + my $key = shift; + my $value = shift; + my $interactive = 0+shift; + my $commchar = ($interactive) ? '=' : '+'; + print $stdout "*** (transmitting to background)\n" + if ($interactive || $verbose); + return if (!$child); + kill 31, $child if ($child); + print C + (substr("${commchar}$key ", 0, 19) . "\n"); + print C (substr(($value . $space_pad), 0, 1024)); + sleep 1; +} + +# getter for internal variables. right now this just returns the variable by +# name and a couple virtuals, but in the future this might be expanded. +sub getvariable { + my $key = shift; + if ($valid{$key}) { + return $$key; + } + if ($key eq 'effpause' || + $key eq 'rate_limit_rate' || + $key eq 'rate_limit_left') { + my $value; + kill 31, $child if ($child); + print C (substr("?$key ", 0, 19) . "\n"); + sysread(W, $value, 1024); + $value =~ s/\s+$//; + return $value; + } + return undef; +} + +# compatibility stub for extensions calling the old wraptime +sub wraptime { return &$wraptime(@_); } + +#### url management (/url, /short) #### + +sub generate_shortdomain { + my $x; + my $y; + + undef $shorturldomain; + ($shorturl =~ m#^http://([^/]+)/#) && ($x = $1); + # chop off any leading hostname stuff (like api., etc.) + while(1) { + $y = $x; + $x =~ s/^[^\.]*\.//; + if ($x !~ /\./) { # a cut too far + $shorturldomain = "http://$y/"; + last; + } + } + print $stdout "-- warning: couldn't parse shortener service\n" + if (!length($shorturldomain)); +} + +sub openurl { + my $comm = $urlopen; + my $url = shift; + $url = "http://gopher.floodgap.com/gopher/gw?".&url_oauth_sub($url) + if ($url =~ m#^gopher://# && $comm !~ /^[^\s]*lynx/); + $urlshort = $url; + $comm =~ s/\%U/'$url'/g; + print $stdout "($comm)\n"; + system("$comm"); +} + +sub urlshorten { + my $url = shift; + my $rc; + my $cl; + + $url = "http://gopher.floodgap.com/gopher/gw?".&url_oauth_sub($url) + if ($url =~ m#^gopher://#); + return $url if ($url =~ /^$shorturldomain/i); # stop loops + $url = &url_oauth_sub($url); + $cl = "$simple_agent \"${shorturl}$url\""; + print $stdout "$cl\n" if ($superverbose); + chomp($rc = `$cl`); + return ($urlshort = (($rc =~ m#^http://#) ? $rc : undef)); +} + +##### optimizers -- these compile into an internal format ##### + +# utility routine for tquery support +sub tracktags_tqueryurlify { + my $value = shift; + $value =~ s/([^ a-z0-9A-Z_])/"%".unpack("H2",$1)/eg; + $value =~ s/\s/+/g; + $value = "q=$value" if ($value !~ /^q=/); + return $value; +} + +# tracking subroutines +# run when a string is passed +sub tracktags_makearray { + @tracktags = (); + $track =~ s/^'//; $track =~ s/'$//; + if (!length($track)) { + @trackstrings = (); + return; + } + my $k; + my $l = ''; + my $q = 0; + my %w; + my (@ptags) = split(/\s+/, $track); + + # filter duplicates and merge quoted strings + foreach $k (@ptags) { + if ($q && $k =~ /"$/) { # this has to be first + $l .= " $k"; + $q = 0; + } elsif ($k =~ /^"/ || $q) { + $l .= (length($l)) ? " $k" : $k; + $q = 1; + next; + } else { + $l = $k; + } + + if ($w{$l}) { + print $stdout + "-- warning: dropping duplicate track term \"$l\"\n"; + } elsif (uc($l) eq 'OR' || uc($l) eq 'AND') { + print $stdout + "-- warning: dropping unnecessary logical op \"$l\"\n"; + } else { + $w{$l} = 1; + push(@tracktags, $l); + } + $l = ''; + } + print $stdout "-- warning: syntax error, missing quote?\n" if ($q); + $track = join(' ', @tracktags); + &tracktags_compile; +} +# run when array is altered (based on @kellyterryjones' code) +sub tracktags_compile { + @trackstrings = (); + return if (!scalar(@tracktags)); + + my $k; + my $l = ''; + my @jtags = map { # don't alter @tracktags, and support UTF-8 + $j=$_; $j=~s/([^0-9a-zA-Z_])/&uhex($1)/eg; $j; + } @tracktags; + # need to make 140 character pieces + TAGBAG: foreach $k (@jtags) { + if (length($k) > 130) { # I mean, really + print $stdout + "-- warning: track tag \"$k\" is TOO LONG\n"; + next TAGBAG; + } + if (length($l)+length($k) > 130) { # reasonable safety + push(@trackstrings, $l); + $l = ''; + } + $l = (length($l)) ? "${l}+OR+${k}" : "q=${k}"; + } + push(@trackstrings, $l) if (length($l)); +} + +# notification multidispatch +sub notifytype_dispatch { + return if (!scalar(@notifytypes)); + my $nt; foreach $nt (@notifytypes) { &$nt(@_); } +} + +# notifications compiler +sub notify_compile { + if ($notifies) { + my $w; + + undef %notify_list; + foreach $w (split(/\s*,\s*/, $notifies)) { + $notify_list{$w} = 1; + } + $notifies = join(',', keys %notify_list); + } +} + +# lists compiler +# we don't check the validity of lists here; /liston and /listoff do that. +sub list_compile { + my @oldlistlist = @listlist; + my %already; + + undef @listlist; + if ($lists) { + my $w; + my $u; + my $l; + foreach $w (split(/\s*,\s*/, $lists)) { + $w =~ s/^@//; + if ($w =~ m#/#) { + ($u, $l) = split(m#\s*/\s*#, $w, 2); + } else { + $l = $w; + } + if (!length($u) && $anonymous) { +print $stdout "*** must use fully specified lists when anonymous\n"; + @listlist = @oldlistlist; + return 0; + } + $u ||= $whoami; + if ($l =~ m#/#) { +print $stdout "*** syntax error in list $u/$l\n"; + @listlist = @oldlistlist; + return 0; + } + if ($already{"$u/$l"}++) { + print $stdout "*** duplicate list $u/$l ignored\n"; + } else { + push(@listlist, [ $u, $l ]); + } + } + $lists = join(',', keys %already); + } + return 1; +} + +# filter compiler +sub filter_compile { + undef %filter_attribs; + undef $filter_c; + if ($filter) { + my $tfilter = $filter; + $tfilter =~ s/^['"]//; + $tfilter =~ s/['"]$//; + # note attributes + $filter_attribs{$1}++ while ($tfilter =~ s/^([a-z]+),//); + my $b = <<"EOF"; + \$filter_c = sub { + local \$_ = shift; + return ($tfilter); + }; +EOF + #print $b; + eval $b; + if (!defined($filter_c)) { + print $stdout ("** syntax error in your filter: $@\n"); + return 0; + } + } + return 1; +} + +#### common system subroutines follow #### + +sub updatecheck { + my $vcheck_url = + "http://www.floodgap.com/software/ttytter/01current.txt"; + my $vrlcheck_url = + "http://www.floodgap.com/software/ttytter/01readlin.txt"; + my $update_url = shift; + + my $vs = ''; + my $vvs; + my $tverify; + my $inversion; + my $bversion; + my $rcnum; + my $download; + my $maj; + my $min; + my $s1, $s2, $s3; + my $update_trlt = undef; + + if ($termrl && $termrl->ReadLine eq 'Term::ReadLine::TTYtter') { + my $trlv = $termrl->Version; + print $stdout + "-- checking Term::ReadLine::TTYtter version: $vrlcheck_url\n"; + $vvs = `$simple_agent $vrlcheck_url`; + print $stdout "-- server response: $vvs\n" if ($verbose); + ($vvs, $s1, $s2, $s3) = split(/--__--\n/s, $vvs); + $s1 = undef if ($s1 !~ /^\*/) ; + $s2 = undef if ($s2 !~ /^\*/) ; + $s3 = undef if ($s3 !~ /^\*/) ; + chomp($vvs); + # right now we're only using $inversion (no betas/rcs). + ($tverify, $inversion, $bversion, $rcnum, $download, + $bdownload) = split(/;/, $vvs, 6); + if ($tverify ne 'trlt') { +$vs .= "-- warning: unable to verify Term::ReadLine::TTYtter version\n"; + } else { + if ($trlv < 0+$inversion) { +$vs .= "** NEW Term::ReadLine::TTYtter VERSION AVAILABLE: $inversion **\n" . + "** GET IT: $download\n"; + $update_trlt = $download; + } else { +$vs .= "-- your version of Term::ReadLine::TTYtter is up to date ($inversion)\n"; + } + } + } + + print $stdout "-- checking TTYtter version: $vcheck_url\n"; + $vvs = `$simple_agent $vcheck_url`; + print $stdout "-- server response: $vvs\n" if ($verbose); + ($vvs, $s1, $s2, $s3) = split(/--__--\n/s, $vvs); + $s1 = undef if ($s1 !~ /^\*/) ; + $s2 = undef if ($s2 !~ /^\*/) ; + $s3 = undef if ($s3 !~ /^\*/) ; + chomp($vvs); + ($tverify, $inversion, $bversion, $rcnum, $download, $bdownload) = + split(/;/, $vvs, 6); + if ($tverify ne 'ttytter') { + $vs .= "-- warning: unable to verify TTYtter version\n"; + } else { + if ($my_version_string eq $bversion) { + $vs .= +"** REMINDER: you are using a beta version (${my_version_string}b${TTYtter_RC_NUMBER})\n"; + $vs .= +"** NEW TTYtter RELEASE CANDIDATE AVAILABLE: build $rcnum **\n" . +"** get it: $bdownload\n$s2" + if ($TTYtter_RC_NUMBER < $rcnum); + $vs .= "** (this is the most current beta)\n" + if ($TTYtter_RC_NUMBER == $rcnum); + $vs .= "$s1$s3"; + if ($TTYtter_RC_NUMBER < $rcnum) { + if ($update_url) { + $vs .= +"-- %URL% is now $bdownload (/short shortens, /url opens)\n"; + $urlshort = $bdownload; + } + } elsif (length($update_trlt) && $update_url) { + $urlshort = $update_trlt; + $vs .= "-- %URL% is now $urlshort (/short shortens, /url opens)\n"; + } + return $vs; + } + if ($my_version_string eq $inversion && $TTYtter_RC_NUMBER) { + $vs .= +"** FINAL TTYtter RELEASE NOW AVAILABLE for version $inversion **\n" . +"** get it: $download\n$s2$s1"; + if ($update_url) { + $vs .= +"-- %URL% is now $bdownload (/short shortens, /url opens)\n"; + $urlshort = $bdownload; + } + return $vs; + } + ($inversion =~/^(\d+\.\d+)\.(\d+)$/) && ($maj = 0+$1, + $min = 0+$2); + if (0+$TTYtter_VERSION < $maj || + (0+$TTYtter_VERSION == $maj && + $TTYtter_PATCH_VERSION < $min)) { + $vs .= + "** NEWER TTYtter VERSION NOW AVAILABLE: $inversion **\n" . + "** get it: $download\n$s2$s1"; + if ($update_url) { + $vs .= +"-- %URL% is now $download (/short shortens, /url opens)\n"; + $urlshort = $download; + } + return $vs; + } elsif (0+$TTYtter_VERSION > $maj || + (0+$TTYtter_VERSION == $maj && + $TTYtter_PATCH_VERSION > $min)) { + $vs .= + "** unable to identify your version of TTYtter\n$s1"; + } else { + $vs .= + "-- your version of TTYtter is up to date ($inversion)\n$s1"; + } + } + + # if we got this far, then there is no TTYtter update, but maybe a + # T:RL:T update, so we offer that as the URL + if (length($update_trlt) && $update_url) { + $urlshort = $update_trlt; + $vs .= "-- %URL% is now $urlshort (/short shortens, /url opens)\n"; + } + return $vs; +} + +sub generate_otabcomp { + if (scalar(@j = keys(%readline_completion))) { + # print optimized readline. include all that we + # manually specified, plus/including top @s, total 10. + @keys = sort { $readline_completion{$b} <=> + $readline_completion{$a} } @j; + $factor = $readline_completion{$keys[0]}; + foreach(keys %original_readline) { + $readline_completion{$_} += $factor; + } + print $stdout "*** optimized readline:\n"; + @keys = sort { $readline_completion{$b} <=> + $readline_completion{$a} } keys + %readline_completion; + @keys = @keys[0..14] if (scalar(@keys) > 15); + print $stdout "-readline=\"@keys\"\n"; + } +} +sub end_me { exit; } # which falls through to, via END, ... +sub killkid { + if ($child) { + print $stdout "\n\ncleaning up.\n"; + if (length($track)) { + print $stdout "*** you were tracking:\n"; + print $stdout "*** -track='$track'\n"; + } + &generate_otabcomp; + kill 9, $child; + } + &$shutdown unless (!$shutdown); +} + +sub generate_ansi { + my $k; + + $BLUE = ($ansi) ? "${ESC}[34;1m" : ''; + $RED = ($ansi) ? "${ESC}[31;1m" : ''; + $GREEN = ($ansi) ? "${ESC}[32;1m" : ''; + $YELLOW = ($ansi) ? "${ESC}[33m" : ''; + $MAGENTA = ($ansi) ? "${ESC}[35m" : ''; + $CYAN = ($ansi) ? "${ESC}[36m" : ''; + + $EM = ($ansi) ? "${ESC}[1m" : ''; + $UNDER = ($ansi) ? "${ESC}[4m" : ''; + $OFF = ($ansi) ? "${ESC}[0m" : ''; + + foreach $k (qw(prompt me dm reply warn search list default)) { + ${"colour$k"} = uc(${"colour$k"}); + if (!defined($${"colour$k"})) { + print $stdout + "-- warning: bogus colour '".${"colour$k"}."'\n"; + } else { + eval("\$CC$k = \$".${"colour$k"}); + } + } + + eval '$termrl->hook_use_ansi' if ($termrl); +} + +# always POST +sub postjson { + my $url = shift; + my $postdata = shift; # add _method=DELETE for delete + my $data; + + # this is copied mostly verbatim from grabjson + chomp($data = &backticks($baseagent, '/dev/null', undef, $url, + $postdata, 0, @wend)); + my $k = $? >> 8; + + $data =~ s/[\r\l\n\s]*$//s; + $data =~ s/^[\r\l\n\s]*//s; + + if (!length($data) || $k == 28 || $k == 7 || $k == 35) { + &$exception(1, "*** warning: timeout or no data\n"); + return undef; + } + + # old non-JSON based error reporting code still supported + if ($data =~ /^\[?\]?<!DOCTYPE\s+html/i || $data =~ /^(Status:\s*)?50[0-9]\s/ || $data =~ /^<html>/i || $data =~ /^<\??xml\s+/) { + print $stdout $data if ($superverbose); + if (&is_fail_whale($data)) { + &$exception(2, "*** warning: Twitter Fail Whale\n"); + } else { + &$exception(2, "*** warning: Twitter error message received\n" . + (($data =~ /<title>Twitter:\s*([^<]+)</) ? + "*** \"$1\"\n" : '')); + } + return undef; + } + if ($data =~ /^rate\s*limit/i) { + print $stdout $data if ($superverbose); + &$exception(3, +"*** warning: exceeded API rate limit for this interval.\n" . +"*** no updates available until interval ends.\n"); + return undef; + } + + if ($k > 0) { + &$exception(4, +"*** warning: unexpected error code ($k) from user agent\n"); + return undef; + } + + # handle things like 304, or other things that look like HTTP + # error codes + if ($data =~ m#^HTTP/\d\.\d\s+(\d+)\s+#) { + $code = 0+$1; + print $stdout $data if ($superverbose); + + # 304 is actually a cop-out code and is not usually + # returned, so we should consider it a non-fatal error + if ($code == 304 || $code == 200 || $code == 204) { + &$exception(1, "*** warning: timeout or no data\n"); + return undef; + } + &$exception(4, +"*** warning: unexpected HTTP return code $code from server\n"); + return undef; + } + + # test for error/warning conditions with trivial case + if ($data =~ /^\s*\{\s*(['"])(warning|error)\1\s*:\s*\1([^\1]*?)\1/s + || $data =~ /(['"])(warning|error)\1\s*:\s*\1([^\1]*?)\1\}/s) { + print $stdout $data if ($superverbose); + &$exception(2, "*** warning: server $2 message received\n" . + "*** \"$3\"\n"); + return undef; + } + + return &parsejson($data); +} + +# always GET +sub grabjson { + my $data; + my $url = shift; + my $last_id = shift; + my $is_anon = shift; + my $count = shift; + my $tag = shift; + my $kludge_search_api_adjust = 0; + my $my_json_ref = undef; # durrr hat go on foot + my $i; + my $tdata; + my $seed; + + #undef $/; $data = <STDIN>; + + # we may need to sort our args for more flexibility here. + my @xargs = (); my $i = index($url, "?"); + if ($i > -1) { + # throw an error if "?" is at the end. + push(@xargs, split(/\&/, substr($url, ($i+1)))); + $url = substr($url, 0, $i); + } + + # count needs to be removed for the default case due to show, etc. + push(@xargs, "count=$count") if ($count); + # timeline control. this speeds up parsing since there's less data. + # can't use skip_user: no SN + push (@xargs, "since_id=${last_id}") if ($last_id); + + my $resource = (scalar(@xargs)) ? + [ $url, join('&', sort @xargs) ] : $url; + + chomp($data = &backticks($baseagent, + '/dev/null', undef, $resource, undef, + $is_anon + $anonymous, @wind)); + my $k = $? >> 8; + + $data =~ s/[\r\l\n\s]*$//s; + $data =~ s/^[\r\l\n\s]*//s; + + if (!length($data) || $k == 28 || $k == 7 || $k == 35) { + &$exception(1, "*** warning: timeout or no data\n"); + return undef; + } + + # old non-JSON based error reporting code still supported + if ($data =~ /^\[?\]?<!DOCTYPE\s+html/i || $data =~ /^(Status:\s*)?50[0-9]\s/ || $data =~ /^<html>/i || $data =~ /^<\??xml\s+/) { + print $stdout $data if ($superverbose); + if (&is_fail_whale($data)) { + &$exception(2, "*** warning: Twitter Fail Whale\n"); + } else { + &$exception(2, "*** warning: Twitter error message received\n" . + (($data =~ /<title>Twitter:\s*([^<]+)</) ? + "*** \"$1\"\n" : '')); + } + return undef; + } + if ($data =~ /^rate\s*limit/i) { + print $stdout $data if ($superverbose); + &$exception(3, +"*** warning: exceeded API rate limit for this interval.\n" . +"*** no updates available until interval ends.\n"); + return undef; + } + + if ($k > 0) { + &$exception(4, +"*** warning: unexpected error code ($k) from user agent\n"); + return undef; + } + + # handle things like 304, or other things that look like HTTP + # error codes + if ($data =~ m#^HTTP/\d\.\d\s+(\d+)\s+#) { + $code = 0+$1; + print $stdout $data if ($superverbose); + + # 304 is actually a cop-out code and is not usually + # returned, so we should consider it a non-fatal error + if ($code == 304 || $code == 200 || $code == 204) { + &$exception(1, "*** warning: timeout or no data\n"); + return undef; + } + &$exception(4, +"*** warning: unexpected HTTP return code $code from server\n"); + return undef; + } + + # test for error/warning conditions with trivial case + if ($data =~ /^\s*\{\s*(['"])(warning|error)\1\s*:\s*\1([^\1]*?)\1/s + || $data =~ /(['"])(warning|error)\1\s*:\s*\1([^\1]*?)\1\}/s) { + print $stdout $data if ($superverbose); + &$exception(2, "*** warning: server $2 message received\n" . + "*** \"$3\"\n"); + return undef; + } + + # THIS IS A TEMPORARY KLUDGE for API issue #26 + # http://code.google.com/p/twitter-api/issues/detail?id=26 + if ($data =~ s/Couldn't find Status with ID=[0-9]+,//) { + print $stdout ">>> cfswi sucky kludge tripped <<<\n" + if ($superverbose); + } + + # if wrapped in results object, unwrap it (@kellyterryjones) + # (and tag it to do more later) + if ($data =~ s/^(\{.+,|\{)\s*['"]results['"]\s*:\s*(\[.*\]).*$/$2/isg) { + $kludge_search_api_adjust = 1; + } + + $my_json_ref = &parsejson($data); + + # normalize the data into a standard form. + # single tweets such as from statuses/show aren't arrays, so + # we special-case for them. + if (defined($my_json_ref) && ref($my_json_ref) eq 'HASH' && + $my_json_ref->{'favorited'} && + $my_json_ref->{'source'} && + ((0+$my_json_ref->{'id'}) || + length($my_json_ref->{'id_str'}))) { + $my_json_ref = &normalizejson($my_json_ref); + } + if (defined($my_json_ref) && ref($my_json_ref) eq 'ARRAY') { + foreach $i (@{ $my_json_ref }) { + $i = &normalizejson($i,$kludge_search_api_adjust,$tag); + } + } + + $laststatus = 0; + return $my_json_ref; +} + +# takes a tweet structure and normalizes it according to settings. +# what this currently does is the following gyrations: +# - if there is no id_str, see if we can convert id into one. if +# there is loss of precision, warn the user. same for +# in_reply_to_status_id_str. +# - if the source of this JSON data source is the Search API, translate +# its fields into the standard API. +# - if the calling function has specified a tag, tag the tweets, since +# we're iterating through them anyway. the tag should be a hashref payload. +# - if the tweet is an newRT, unwrap it so that the full tweet text is +# revealed (unless -nonewrts). +# - if this appears to be a tweet, put in a stub geo hash if one does +# not yet exist. +# one day I would like this code to go the hell away. +sub normalizejson { + my $i = shift; + my $kludge_search_api_adjust = shift; + my $tag = shift; + my $rt; + + # tag the tweet + $i->{'tag'} = $tag if (defined($tag)); + + # id -> id_str if needed + if (!length($i->{'id_str'})) { + my $k = "" + (0 + $i->{'id'}); + if ($k !~ /[eE][+-]/) { + $i->{'id_str'} = $k; + } else { + # desperately try to convert + $k =~ s/[eE][+-]\d+$//; + $k =~ s/\.//g; + # this is a hack, so we warn. + &$exception(13, +"*** impending doom: ID overflows Perl precision; stubbed to $k\n"); + $i->{'id_str'} = $k; + } + } + # irtsid -> irtsid_str (if there is one) + if (!length($i->{'in_reply_to_status_id_str'}) && + $i->{'in_reply_to_status_id'}) { + my $k = "" + (0+$i->{'in_reply_to_status_id'}); + if ($k !~ /[eE][+-]/) { + $i->{'in_reply_to_status_id_str'} = $k; + } else { + # desperately try to convert + $k =~ s/[eE][+-]\d+$//; + $k =~ s/\.//g; + # this is a hack, so we warn. + &$exception(13, +"*** impending doom: IRT-ID overflows Perl precision; stubbed to $k\n"); + $i->{'in_reply_to_status_id_str'} = $k; + } + } + + # normalize geo. if this has a source and it has a + # favorited, then it is probably a tweet and we will + # add a stub geo hash if one doesn't exist yet. + if ($kludge_search_api_adjust || + ($i->{'favorited'} && $i->{'source'})){ + $i = &fix_geo_api_data($i); + } + + # normalize Search + if ($kludge_search_api_adjust) { + # hopefully this hack can die with API v2. + $i->{'class'} = "search"; + $i->{'user'}->{'screen_name'} = + $i->{'from_user'}; + # translate time stamps + # Fri Mar 20 13:18:18 +0000 2009 (twitter) vs + # Fri, 20 Mar 2009 16:35:56 +0000 (search) + $i->{'created_at'} =~ + s/(...), (..) (...) (....) (..:..:..) (.....)/\1 \3 \2 \5 \6 \4/; + } + + # normalize newRTs + # if we get newRTs with -nonewrts, oh well + if (!$nonewrts && ($rt = $i->{'retweeted_status'})) { + # reconstruct the RT in a "canonical" format + # without truncation + $i->{'text'} = + "RT \@$rt->{'user'}->{'screen_name'}" . ': ' . $rt->{'text'}; + } + + return $i; +} + +# process the JSON data ... simplemindedly, because I just write utter crap, +# am not a professional programmer, and don't give a flying fig whether +# kludges suck or no. this used to be part of grabjson, but I split it out. +sub parsejson { + my $data = shift; + my $my_json_ref = undef; # durrr hat go on foot + my $i; + my $tdata; + my $seed; + my $bbqqmask; + my $ddqqmask; + my $ssqqmask; + + # test for single logicals + return { + 'ok' => 1, + 'result' => (($1 eq 'true') ? 1 : 0), + 'literal' => $1, + } if ($data =~ /^['"]?(true|false)['"]?$/); + + # first isolate escaped backslashes with a unique sequence. + $bbqqmask = "BBQQ"; + $seed = 0; + $seed++ while ($data =~ /$bbqqmask$seed/); + $bbqqmask .= $seed; + $data =~ s/\\\\/$bbqqmask/g; + + # next isolate escaped quotes with another unique sequence. + $ddqqmask = "DDQQ"; + $seed = 0; + $seed++ while ($data =~ /$ddqqmask$seed/); + $ddqqmask .= $seed; + $data =~ s/\\\"/$ddqqmask/g; + + # then turn literal ' into another unique sequence. you'll see + # why momentarily. + $ssqqmask = "SSQQ"; + $seed = 0; + $seed++ while ($data =~ /$ssqqmask$seed/); + $ssqqmask .= $seed; + $data =~ s/\'/$ssqqmask/g; + + # here's why: we're going to turn doublequoted strings into single + # quoted strings to avoid nastiness like variable interpolation. + $data =~ s/\"/\'/g; + + # and then we're going to turn the inline ones all back except + # ssqq, which we'll do last so that our syntax checker still works. + $data =~ s/$bbqqmask/\\\\/g; + $data =~ s/$ddqqmask/"/g; + + print $stdout "$data\n" if ($superverbose); + + # trust, but verify. I'm sure twitter wouldn't send us malicious + # or bogus JSON, but one day this might talk to something that would. + # in particular, need to make sure nothing in this will eval badly or + # run arbitrary code. that would really suck! + # first, generate a syntax tree. + $tdata = $data; + 1 while $tdata =~ s/'[^']*'//; # empty strings are valid too ... + $tdata =~ s/-?[0-9]+\.?[0-9]*([eE][+-][0-9]+)?//g; + # have to handle floats *and* their exponents + $tdata =~ s/(true|false|null)//g; + $tdata =~ s/\s//g; + + print $stdout "$tdata\n" if ($superverbose); + + # now verify the syntax tree. + # the remaining stuff should just be enclosed in [ ], and only {}:, + # for example, imagine if a bare semicolon were in this ... + if ($tdata !~ s/^\[// || $tdata !~ s/\]$// || $tdata =~ /[^{}:,]/) { + $tdata =~ s/'[^']*$//; # cut trailing strings + if (($tdata =~ /^\[/ && $tdata !~ /\]$/) + || ($tdata =~ /^\{/ && $tdata !~ /\}$/)) { + # incomplete transmission + &$exception(10, "*** JSON warning: connection cut\n"); + return undef; + } +# it seems that :[], or :[]} should be accepted as valid in the syntax tree +# since identica uses this as possible for null properties +# ,[], shouldn't be, etc. + if ($tdata =~ /(^|[^:])\[\]($|[^},])/) { # oddity + &$exception(11, "*** JSON warning: null list\n"); + return undef; + } + # total failure should fail hard, because this indicates an + # absolutely serious error at this stage (all traps failed) + &screech + ("$data\n$tdata\nJSON IS UNSAFE TO EXECUTE! BAILING OUT!\n") + if ($tdata =~ /[^\[\]\{\}:,]/); + } + + # syntax tree passed, so let's turn it into a Perl reference. + # have to turn colons into ,s or Perl will gripe. but INTELLIGENTLY! + 1 while + ($data =~ s/([^'])'\s*:\s*(true|false|null|\'|\{|\[|-?[0-9])/\1\',\2/); + + # finally, single quotes, just before interpretation. + $data =~ s/$ssqqmask/\\'/g; + + # now somewhat validated, so safe (?) to eval() into a Perl struct + eval "\$my_json_ref = $data;"; + print $stdout "$data => $my_json_ref $@\n" if ($superverbose); + + # do a sanity check + &screech("$data\n$tdata\nJSON could not be parsed: $@\n") + if (!defined($my_json_ref)); + + return $my_json_ref; +} + +sub fix_geo_api_data { + my $ref = shift; + $ref->{'geo'}->{'coordinates'} ||= [ "undef", "undef" ]; + return $ref; +} + +sub is_fail_whale { + # is this actually the dump from a fail whale? + my $data = shift; + return ($data =~ m#<title>Twitter.+Over.+capacity.*</title>#i || + $data =~ m#[\r\l\n\s]*DB_DataObject Error: Connect failed#s); +} + +sub is_json_error { + # is this actually a JSON error message? if so, extract it + my $data = shift; + if ($data =~ /(['"])(warning|errors?)\1\s*:\s*\1([^\1]*?)\1\}/s) { + my $probe = $3; + if ($data =~ /^\s*\{/s) { # JSON object? + my $dref = &parsejson($data); + return $dref->{'error'} if (length($dref->{'error'})); + return (split(/\\n/, $dref->{'errors'}))[0] + if(length($dref->{'errors'})); + } + return $probe; + } + return undef; +} + +sub backticks { + # more efficient/flexible backticks system + my $comm = shift; + my $rerr = shift; + my $rout = shift; + my $resource = shift; + my $data = shift; + my $dont_do_auth = shift; + my $buf = ''; + my $undersave = $_; + my $pid; + my $args; + + ($comm, $args, $data) = &$stringify_args($comm, $resource, + $data, $dont_do_auth, @_); + print $stdout "$comm\n$args\n$data\n" if ($superverbose); + if(open(BACTIX, '-|')) { + while(<BACTIX>) { + $buf .= $_; + } close(BACTIX); + $_ = $undersave; + return $buf; # and $? is still in $? + } else { + $in_backticks = 1; + $SIG{'ALRM'} = sub { + die( + "** user agent not honouring timeout (caught by sigalarm)\n"); + }; + alarm 120; # this should be sufficient + if (length($rerr)) { + close(STDERR); + open(STDERR, ">$rerr"); + } + if (length($rout)) { + close(STDOUT); + open(STDOUT, ">$rout"); + } + if(open(FRONTIX, "|$comm")) { + print FRONTIX "$args\n"; + print FRONTIX "$data" if (length($data)); + close(FRONTIX); + } else { + die( + "backticks() failure for $comm $rerr $rout @_: $!\n"); + } + $rv = $? >> 8; + exit $rv; + } +} + +sub wherecheck { + my ($prompt, $filename, $fatal) = (@_); + my (@paths) = split(/\:/, $ENV{'PATH'}); + my $setv = ''; + + push(@paths, '/usr/bin'); # the usual place + @paths = ('') if ($filename =~ m#^/#); # for absolute paths + + print $stdout "$prompt ... " unless ($silent); + foreach(@paths) { + if (-r "$_/$filename") { + $setv = "$_/$filename"; + 1 while $setv =~ s#//#/#; + print $stdout "$setv\n" unless ($silent); + last; + } + } + if (!length($setv)) { + print $stdout "not found.\n"; + if ($fatal) { + print $stdout $fatal; + exit(1); + } + } + return $setv; +} + +sub screech { + print $stdout "\n\n${BEL}${BEL}@_"; + if ($is_background) { + kill 9, $parent; + kill 9, $$; + } elsif ($child) { + kill 9, $child; + kill 9, $$; + } + die("death not achieved conventionally"); +} + +sub descape { + my $x = shift; + my $mode = shift; + + $x =~ s#\\/#/#g; + + # try to do something sensible with unicode + if ($mode) { # this probably needs to be revised + $x =~ s/\\u([0-9a-fA-F]{4})/"&#" . hex($1) . ";"/eg; + } else { + # intermediate form if HTML entities get in + $x =~ s/\&\#([0-9]+);/'\u' . sprintf("%04x", $1)/eg; + + $x =~ s/\\u2028/\\n/g; + if ($seven) { + # known UTF-8 entities (char for char only) + $x =~ s/\\u201[89]/\'/g; + $x =~ s/\\u201[cCdD]/\"/g; + + # 7-bit entities (32-126) also ok + $x =~ s/\\u00([2-7][0-9a-fA-F])/chr(((hex($1)==127)?46:hex($1)))/eg; + + # dot out the rest + $x =~ s/\\u([0-9a-fA-F]{4})/./g; + $x =~ s/[\x80-\xff]/./g; + } else { + # try to promote to UTF-8 + &$utf8_decode($x); + $x =~ s/\\u([0-9a-fA-F]{4})/chr(hex($1))/eg; + $x = &uforcemulti($x); + } + $x =~ s/\"/"/g; + $x =~ s/\'/'/g; + $x =~ s/\</\</g; + $x =~ s/\>/\>/g; + $x =~ s/\&/\&/g; + } + if ($newline) { + $x =~ s/\\n/\n/sg; + $x =~ s/\\r//sg; + } + return $x; +} + +sub max { return ($_[0] > $_[1]) ? $_[0] : $_[1]; } +sub min { return ($_[0] < $_[1]) ? $_[0] : $_[1]; } +sub prolog { my $k = shift; + return "" if (!scalar(@_)); + my $l = shift; return (&$k($l) . &$k(@_)); } +# this is mostly a utility function for /eval. it is a recursive descent +# pretty printer. +sub a { + my $w; + my $x; + return '' if(scalar(@_) < 1); + if(scalar(@_) > 1) { $x = "("; + foreach $w (@_) { + $x .= &a($w); + } + return $x."), "; + } + $w = shift; + if(ref($w) eq 'SCALAR') { return "\\\"". $$w . "\", "; } + if(ref($w) eq 'HASH') { my %m = %{ $w }; + return "\n\t{".&prolog(\&a, %m)."}, "; } + if(ref($w) eq 'ARRAY') { return "\n\t[".&prolog(\&a, @{ $w })."], "; } + return "\"$w\", "; +} +sub ssa { return (scalar(@_) ? ("('" . join("', '", @_) . "')") : "NULL"); } + +sub strim { my $x=shift; $x=~ s/^\s+//; $x=~ s/\s+$//; return $x; } + +sub wwrap { + return shift if (!$wrap); + + my $k; + my $klop = ($wrap > 1) ? $wrap : ($ENV{'COLUMNS'} || 79); + $klop--; # don't ask me why + my $lop; + my $buf = ''; + my $string = shift; + my $indent = shift; # for very first time with the prompt + my $needspad = 0; + my $stringpad = " " x 3; + + $indent += 4; # for the menu select string + + $lop = $klop - $indent; + $lop -= $indent; + W: while($k = length($string)) { + $lop += $indent if ($lop < $klop); + ($buf .= $string, last W) if ($k <= $lop && $string !~ /\n/); + ($string =~ s/^\s*\n//) && ($buf .= "\n", + $needspad = 1, + next W); + if ($needspad) { + $string = " $string"; + $needspad = 0; + } + # I don't know if people will want this, so it's commented out. + #($string =~ s#^(http://[^\s]+)# #) && ($buf .= "$1\n", + # next W); + ($string =~ s/^(.{4,$lop})\s/ /) && ($buf .= "$1\n", + next W); # i.e., at least one char, plus 3 space indent + ($string =~ s/^(.{$lop})/ /) && ($buf .= "$1\n", + next W); + warn + "-- pathologic string somehow failed wordwrap! \"$string\"\n"; + return $buf; + } + 1 while ($buf =~ s/\n\n\n/\n\n/s); # mostly paranoia + $buf =~ s/[ \t]+$//; + return $buf; +} + +# these subs look weird, but they're encoding-independent and run anywhere +sub uforcemulti { # forces multi-byte interpretation by abusing Perl + my $x = shift; + return $x if ($seven); + $x = "\x{263A}".$x; + return pack("${pack_magic}H*", substr(unpack("${pack_magic}H*",$x),6)); +} +sub ulength { my @k; return (scalar(@k = unpack("${pack_magic}C*", shift))); } +sub uhex { + # URL-encode an arbitrary string, even UTF-8 + # more versatile than the miniature one in &updatest + my $k = ''; + my $s = shift; + &$utf8_encode($s); + + foreach(split(//, $s)) { + my $j = unpack("H256", $_); + while(length($j)) { + $k .= '%' . substr($j, 0, 2); + $j = substr($j, 2); + } + } + return $k; +} + +# take a string and return up to $linelength CHARS plus the rest. +sub csplit { return &cosplit(@_, sub { return length(shift); }); } +# take a string and return up to $linelength BYTES plus the rest. +sub usplit { return &cosplit(@_, sub { return &ulength(shift); }); } +sub cosplit { + # this is the common code for &csplit and &usplit. + # this is tricky because we don't want to split up UTF-8 sequences, so + # we let Perl do the work since it internally knows where they end. + my $orig_k = shift; + my $mode = shift; + my $lengthsub = shift; + my $z; + my @m; + my $q; + my $r; + + $mode += 0; + $k = $orig_k; + + # optimize whitespace + $k =~ s/^\s+//; + $k =~ s/\s+$//; + $k =~ s/\s+/ /g; + $z = &$lengthsub($k); + return ($k) if ($z <= $linelength); # also handles the trivial case + + # this needs to be reply-aware, so we put @'s at the beginning of + # the second half too (and also Ds for DMs) + $r .= $1 if ($k =~ s/^(\@[^\s]+\s)\s*// || + $k =~ s/^(D\s+[^\s]+\s)\s*//); # not while -- just one + $k = "$r$k"; + + my $i = $linelength; + $i-- while(($z = &$lengthsub($q = substr($k, 0, $i))) > $linelength); + $m = substr($k, $i); + + # if we just wanted split-on-byte, return now (mode = 1) + if ($mode) { + # optimize again in case we split on whitespace + $q =~ s/\s+$//; + $m =~ s/^\s+//; + return ($q, "$r$m"); + } + + # else try to do word boundary and cut even more + if (!$autosplit) { # use old mechanism first: drop trailing non-alfanum + ($q =~ s/([^a-zA-Z0-9]+)$//) && ($m = "$1$m"); + # optimize again in case we split on whitespace + $q =~ s/\s+$//; + return (&cosplit($orig_k, 1, $lengthsub)) + if (!length($q) && !$mode); + # it totally failed. fall back on charsplit. + if (&$lengthsub($q) < $linelength) { + $m =~ s/^\s+//; + return($q, "$r$m") + } + } + ($q =~ s/\s+([^\s]+)$//) && ($m = "$1$m"); + return (&cosplit($orig_k, 1, $lengthsub)) if (!length($q) && !$mode); + # it totally failed. fall back on charsplit. + return ($q, "$r$m"); +} + +### OAuth and xAuth methods, including our own homegrown SHA-1 and HMAC ### +### no Digest:* required! ### +### these routines are not byte-safe and need a use bytes; before you call ### + +# this is a modified, deciphered and deobfuscated version of the famous Perl +# one-liner SHA-1 written by John Allen. hope he doesn't mind. +sub sha1 { + my $string = shift; + print $stdout "string length: @{[ length($string) ]}\n" + if ($showwork); + + my $constant = "D9T4C`>_-JXF8NMS^\$#)4=L/2X?!:\@GF9;MGKH8\\;O-S*8L'6"; + my @A = unpack('N*', unpack('u', $constant)); + my @K = splice(@A, 5, 4); + my $M = sub { # 64-bit warning + my $x; + my $m; + ($x = pop @_) - ($m=4294967296) * int($x / $m); + }; + my $L = sub { # 64-bit warning + my $n = pop @_; + my $x; + ((($x = pop @_) << $n) | ((2 ** $n - 1) & ($x >> 32 - $n))) & + 4294967295; + }; + my $l = ''; + my $r; + my $a; + my $b; + my $c; + my $d; + my $e; + my $us; + my @nuA; + my $p = 0; + $string = unpack("H*", $string); + + do { + my $i; + $us = substr($string, 0, 128); + $string = substr($string, 128); + $l += $r = (length($us) / 2); + print $stdout "pad length: $r\n" if ($showwork); + ($r++, $us .= "80") if ($r < 64 && !$p++); + my @W = unpack('N16', pack("H*", $us) . "\000" x 7); + $W[15] = $l * 8 if ($r < 57); + foreach $i (16 .. 79) { + push(@W, + &$L($W[$i - 3] ^ $W[$i - 8] ^ $W[$i - 14] ^ $W[$i - 16], 1)); + } + ($a, $b, $c, $d, $e) = @A; + foreach $i (0 .. 79) { + my $qq = ($i < 20) ? ($b & ($c ^ $d) ^ $d) : + ($i < 40) ? ($b ^ $c ^ $d) : + ($i < 60) ? (($b | $c) & $d | $b & $c) : + ($b ^ $c ^ $d); + $t = &$M($qq + $e + $W[$i] + $K[$i / 20] + &$L($a, 5)); + $e = $d; + $d = $c; + $c = &$L($b, 30); + $b = $a; + $a = $t; + } + @nuA = ($a, $b, $c, $d, $e); + print $stdout "$a $b $c $d $e\n" if ($showwork); + $i = 0; + @A = map({ &$M($_ + $nuA[$i++]); } @A); + } while ($r > 56); + my $x = sprintf('%.8x' x 5, @A); + @A = unpack("C*", pack("H*", $x)); + return($x, @A); +} + +# heavily modified from MIME::Base64 +sub simple_encode_base64 { + my $result = ''; + my $input = shift; + + pos($input) = 0; + while($input =~ /(.{1,45})/gs) { + $result .= substr(pack("u", $1), 1); + chop($result); + } + $result =~ tr|` -_|AA-Za-z0-9+/|; + my $padding = (3 - length($input) % 3) % 3; + $result =~ s/.{$padding}$/("=" x $padding)/e if ($padding); + + return $result; +} + +# from RFC 2104/RFC 2202 + +sub hmac_sha1 { + my $message = shift; + my @key = (@_); + my $opad; + my $ipad; + my $i; + my @j; + + # sha1 blocksize is 512, so key should be 64 bytes + +print $stdout " KEY HASH \n" if ($showwork); + ($i, @key) = &sha1(pack("C*", @key)) while (scalar(@key) > 64); + push(@key, 0) while(scalar(@key) < 64); + $opad = pack("C*", map { ($_ ^ 92) } @key); + $ipad = pack("C*", map { ($_ ^ 54) } @key); + +print $stdout " MESSAGE HASH \n" if ($showwork); + ($i, @j) = &sha1($ipad . $message); +print $stdout " FINAL HASH \n" if ($showwork); + $i = pack("C*", @j); # output hash is 160 bits + ($i, @j) = &sha1($opad . $i); + $i = &simple_encode_base64(pack("C20", @j)); + + return $i; +} + +# simple encoder for OAuth modified URL encoding (used for lots of things, +# actually) +# this is NOT UTF-8 safe +sub url_oauth_sub { + my $x = shift; + $x =~ s/([^-0-9a-zA-Z._~])/"%".uc(unpack("H2",$1))/eg; return $x; +} + +# default method of getting password: ask for it. only relevant for xAuth +# and Basic Auth, neither of which is our default. +sub defaultgetpassword { + # original idea by @jcscoobyrs, heavily modified + my $k; + my $l; + my $pass; + + $l = "no termios; password WILL"; + if ($termios) { + $termios->getattr(fileno($stdin)); + $k = $termios->getlflag; + $termios->setlflag($k ^ &POSIX::ECHO); + $termios->setattr(fileno($stdin)); + $l = "password WILL NOT"; + } + print $stdout "enter password for $whoami ($l be echoed): "; + chomp($pass = <$stdin>); + if ($termios) { + print $stdout "\n"; + $termios->setlflag($k); + $termios->setattr(fileno($stdin)); + } + return $pass; +} + +# this returns an immutable token corresponding to the current authenticated +# session. in the case of Basic Auth, it is simply the user:password pair. +# in the case of xAuth, it executes a fetch for the token and token secret. +# it does not handle OAuth -- that is run by a separate wizard. +# the function then returns (token,secret) which for Basic Auth is token,undef. +# +# most of the time we will be using tokens in a keyfile, however, so this +# function runs in that case as a stub. +sub authtoken { + my @foo; + my $pass; + my $sig; + my $return; + my $tries = ($hold > 3) ? $hold : 3; + # give up on token if we don't get one + + return (undef,undef) if ($anonymous); + return ($tokenkey,$tokensecret) + if (length($tokenkey) && length($tokensecret)); + @foo = split(/:/, $user, 2); + $whoami = $foo[0]; + die("choose -user=username[:password], or -anonymous.\n") + if (!length($whoami) || $whoami eq '1'); + $pass = length($foo[1]) ? $foo[1] : &$getpassword; + die("a password must be specified.\n") if (!length($pass)); + return ($whoami, $pass) if ($authtype eq 'basic'); + + print $stdout <<"EOF"; +>> WARNING: xAuth is now deprecated in TTYtter 1.2, and will be gone in 2.0 +>> if this is an issue for your application, notify ckaiser\@floodgap.com + +EOF + + print $stdout "negotiating xAuth token ..."; + + my $rawtoken; + while($tries) { + $rawtoken = &backticks($baseagent, + '/dev/null', + undef, + $xauthurl, + ("x_auth_mode=client_auth&" . + "x_auth_password=" . &url_oauth_sub($pass) . "&". + "x_auth_username=" . &url_oauth_sub($whoami)), + 0, @wend); + my $i; + print $stdout ("token = $rawtoken\n") if ($superverbose); + my (@keyarr) = split(/\&/, $rawtoken); + my $got_token = ''; + my $got_secret = ''; + foreach $i (@keyarr) { + my $key; + my $value; + + ($key, $value) = split(/\=/, $i); + $got_token = $value if ($key eq 'oauth_token'); + $got_secret = $value if ($key eq 'oauth_token_secret'); + if (length($got_token) && length($got_secret)) { + print $stdout " SUCCEEDED!\n"; + return ($got_token, $got_secret); + } + } + print $stdout "."; + $tries--; + } + print $stdout " FAILED!: \"$rawtoken\"\n"; +die("unable to fetch xAuth token. other possible reasons:\n". + " - root certificates are not updated (see documentation)\n". + " - your password is wrong\n". + " - your computer's clock is not set correctly\n" . + " - Twitter farted\n" . + "fix these possible problems, or try again later.\n"); +} + +# this is a sucky nonce generator. I was looking for an awesome nonce +# generator, and then I realized it would only be used once, so who cares? +# *rimshot* +sub generate_nonce { unpack("H9000", pack("u", rand($$).$$.time())); } + +# this signs a request with the token and token secret. the result is undef if +# Basic Auth. payload should already be URL encoded and *sorted*. +# this is typically called by stringify_args to get authentication information. +sub signrequest { + + # this horrible kludge is needed to account for both 5.005, or for + # 5.6+ installs with no stdlibs and just a bare Perl, both of which + # we support. I hope Larry Wall will forgive me for messing with + # compiler internals next time I see him at church. + BEGIN { $^H |= 0x00000008 unless ($] < 5.006); } + + my $resource = shift; + my $payload = shift; + + # when we sign the initial request for an xAuth token, we obviously + # don't have one yet, so mytoken/mytokensecret can be null. + + my $nonce = &generate_nonce; + my @keybytes; + my $sig_base; + my $timestamp = time(); + return undef if ($authtype eq 'basic'); + + # stub for oAuth 2.0 + return undef if (!length($oauthkey) || !length($oauthsecret)); + + (@keybytes) = map { ord($_) } + split(//, $oauthsecret.'&'.$mytokensecret); + if (ref($resource) eq 'ARRAY' || length($payload)) { + # split into _a and _b payloads lexically + my $payload_a = ''; + my $payload_b = ''; + my $payload_c = ''; # this is for a special case + my $w; + my $aorb = 0; + my $verifier = ''; + my $method = "GET"; + my $url; + + if (length($payload)) { + $method = "POST"; + # this is a bit problematic since it won't be + # sorted. we'll deal with this as we need to. + if (ref($resource) eq 'ARRAY') { + $url = &url_oauth_sub($resource->[0]); + $payload .= "&" . $resource->[1]; + } else { + $url = &url_oauth_sub($resource); + } + } elsif (ref($resource) eq 'ARRAY') { + $url = &url_oauth_sub($resource->[0]); + $payload = $resource->[1]; + } else { + $url = &url_oauth_sub($resource); + } + + # this is pretty simplistic but it's really all we need. + # the exception is oauth_verifier: that has to be wormed + # into the middle, and we assume it's just that. + if ($payload !~ /^oauth_verifier/) { + foreach $w (split(/\&/, $payload)) { + $aorb = 1 if + ($w =~ /^[p-z]/ || $w =~ /^o[b-z]/); + $w = &url_oauth_sub("${w}&"); + if ($aorb) { + $payload_b .= $w; + } else { + $payload_a .= $w; + } + } + } else { + $payload_c = &url_oauth_sub($payload) . "%26"; + $payload_a = $payload_b = ''; + $payload =~ s/^oauth_verifier=//; + $verifier = ' oauth_verifier=\\"' . $payload . '\\",'; + } + $payload_b =~ s/%26$//; + $sig_base = $method . "&" . + $url . "&" . + (length($payload_a) ? $payload_a : ''). + "oauth_consumer_key%3D" . $oauthkey . "%26" . + "oauth_nonce%3D" . $nonce . "%26" . + "oauth_signature_method%3DHMAC-SHA1%26" . + "oauth_timestamp%3D" . $timestamp . "%26" . + (length($mytoken) ? + ("oauth_token%3D" . $mytoken . "%26") : '') . + $payload_c . + "oauth_version%3D1.0" . + (length($payload_b) ? ("%26" . $payload_b) : ''); + } else { + $sig_base = "GET&" . + &url_oauth_sub($resource) . "&" . + "oauth_consumer_key%3D" . $oauthkey . "%26" . + "oauth_nonce%3D" . $nonce . "%26" . + "oauth_signature_method%3DHMAC-SHA1%26" . + "oauth_timestamp%3D" . $timestamp . "%26" . + (length($mytoken) ? + ("oauth_token%3D" . $mytoken . "%26") : '') . + $payload_c . # could be part of it + "oauth_version%3D1.0" ; + } + print $stdout +"token-secret: $mytokensecret\nconsumer-secret: $oauthsecret\nsig-base: $sig_base\n" + if ($superverbose); + return ($timestamp, $nonce, + &url_oauth_sub(&hmac_sha1($sig_base, @keybytes)), + $verifier); +} + +# this takes a token request and "tries hard" to get it. this is descended +# from the xAuth flow, but works for any generic token. please note: xAuth +# is now deprecated as of 1.2. +sub tryhardfortoken { + my $url = shift; + my $body = shift; + my $tries = shift; + my $rawtoken; + $tries ||= 3; + + while($tries) { + my $i; + $rawtoken = &backticks($baseagent, '/dev/null', undef, + $url, $body, 0, @wend); + print $stdout ("token = $rawtoken\n") + if ($superverbose); + my (@keyarr) = split(/\&/, $rawtoken); + my $got_token = ''; + my $got_secret = ''; + foreach $i (@keyarr) { + my $key; + my $value; + + ($key, $value) = split(/\=/, $i); + $got_token = $value if ($key eq 'oauth_token'); + $got_secret = $value if ($key eq 'oauth_token_secret'); + } + if (length($got_token) && length($got_secret)) { + print $stdout " SUCCEEDED!\n"; + return ($got_token, $got_secret); + } + print $stdout "."; + $tries--; + } + print $stdout " FAILED!: \"$rawtoken\"\n"; +die("unable to fetch token. here are some possible reasons:\n". + " - root certificates are not updated (see documentation)\n". + " - you entered your authentication information wrong\n". + " - your computer's clock is not set correctly\n" . + " - Twitter farted\n" . + "fix these possible problems, or try again later.\n"); + exit; +} @@ -0,0 +1,71 @@ +#!/usr/bin/perl + +use strict 'subs'; +use strict 'refs'; + +@dev = ('--device', '/dev/pg0:0,0'); + +sub help { + print "Syntax: $0 [-H] [options] audiofiles\n"; + print <<"EOF" ; +Use cdrdao on the wav audio file arguments, making an appropriate toc file. +-d cdrw Use cdrw as the CDRW device (default: $dev[1]). +-o file Output the toc file on this file - do not use a temporary file. +-p Perform a 'print-size' cdrdao command. +-i Perform a 'toc-info' cdrdao command. +-c Perform a 'show-toc' cdrdao command. +-t Perform a 'read-test' cdrdao command. +-w Write the CD in DAO mode (default, if no other action is specified). +-s Simulate writing only ('simulate' instead of 'write' command). +-j Do not eject the CD after writing it. +-n Print the cdrdao commands, instead of executing them. +EOF +} + +require 'getopts.pl'; +&Getopts('o:pictwsjnH'); +if ($opt_H) { &help ; exit } +$dev[1] = $opt_d if $opt_d; +$opt_w = 1 unless $opt_p || $opt_i || $opt_c || $opt_t || $opt_w || $opt_s || $opt_o ne ""; + +die "Usage: $0 [options] audiofiles" unless @ARGV; + +$fname = $opt_o ne "" ? $opt_o : "/tmp/toc$$"; +open(F, "> $fname") || die "open($fname): $!, stopped"; +print F "CD_DA\n"; + +foreach (@ARGV) { + print F "\nTRACK AUDIO\nNO COPY\n"; +# print F "NO PRE_EMPHASIS\nTWO_CHANNEL_AUDIO\n"; + print F "FILE \"$_\" 0\n"; +# print F "START 00:02:00\n" if $no++; +} +close F; + +if ($opt_p) { + if ($opt_n) { print "cdrdao print-size $fname\n" } + else { system 'cdrdao', 'print-size', $fname} +} + +if ($opt_i) { + if ($opt_n) { print "cdrdao toc-info $fname\n" } + else { system 'cdrdao', 'toc-info', $fname} +} + +if ($opt_c) { + if ($opt_n) { print "cdrdao show-toc $fname\n" } + else { system 'cdrdao', 'show-toc', $fname} +} +if ($opt_t) { + if ($opt_n) { print "cdrdao read-test $fname\n" } + else { system 'cdrdao', 'read-test', $fname} +} + +if ($opt_w || $opt_s) { + unshift @dev, $opt_s ? 'simulate' : 'write'; + push @dev, '--eject' unless $opt_s || $opt_j; + push @dev, $fname; + if ($opt_n) { print "cdrdao @dev\n" } else { system 'cdrdao', @dev } +} +unlink $fname unless $opt_o ne ""; +__END__ diff --git a/weather-query b/weather-query new file mode 100755 index 0000000..774bb73 --- /dev/null +++ b/weather-query @@ -0,0 +1,13 @@ +#!/bin/bash +# +# Simple wrapper around brweather +# + +PROGRAM="$1" +shift + +if [ "$PROGRAM" == 'brweather' ]; then + brweather $* | grep -v 'Erro.' +else + weather $* +fi @@ -0,0 +1,30 @@ +# +# Workscreen: screen session wrapper. +# + +# Default options. +opts="-c /etc/screenrc" + +# Remove dead screens. +screen -wipe &> /dev/null + +# Session selection. +if [ ! -z "$1" ]; then + if screen -ls $1 | grep -q "There is a screen on"; then + #echo "There's already a screen called $1" + #exit 1 + screen -x $1 + exit $? + else + session="-S $1" + fi + + if [ "$1" == "main" ]; then + opts="" + elif [ -f "$HOME/.screen/$1" ]; then + opts="-c $HOME/.screen/$1" + fi +fi + +# Start session. +screen $opts $session @@ -0,0 +1,19 @@ +#!/bin/bash +# +# start multiple conky instances +# + +# Default one +conky & + +# Give time for networking +sleep 60 + +# Load weather data first +weather &> /dev/null + +# Clear cache +brweather --clean-cache + +# Weather +conky -c ~/.conky/weather/conkyrc & diff --git a/xhibernate b/xhibernate new file mode 100755 index 0000000..d633ec3 --- /dev/null +++ b/xhibernate @@ -0,0 +1,3 @@ +#!/bin/bash +xlock & +sudo pm-hibernate @@ -0,0 +1,16 @@ +#!/bin/bash +# +# xirssi: execute irssi under a terminal +# + +source ~/.geometry || exit 1 + +#Eterm --background-pixmap 0 --scrollbar 0 +sb -b black -f white -F vga --borderless no --buttonbar 0 \ +# -g 120x40+30+55 -nIrssi -e irssi + +#Eterm --background-pixmap 0 --scrollbar 0 +sb -b black -f white \ +# -F $FONT --borderless no --buttonbar 0 \ +# -g $GEOMETRY -nirssi -e irssi +#rxvt-unicode -bg black +sb -fg white -fn $FONT -g $GEOMETRY -title irssi -e irssi + +xterm -u8 -fn $FONT -geometry $GEOMETRY -e irssi @@ -0,0 +1 @@ +xscreensaver-command --lock @@ -0,0 +1,16 @@ +#!/bin/bash +# +# xmutt: wrapper for mutt +# + +source ~/.geometry || exit 1 + +# Using rxvt +#rxvt -geometry 110x45 -fn 7x13 -e mutt +#rxvt -g 110x45+320+90 +sb -fn smooth -name mutt -e mutt + +# Using Eterm +#Eterm -g $GEOMETRY +sb -f white -F $FONT --borderless no --buttonbar 0 \ +# --scrollbar 0 -P $HOME/themes/ground.jpg@:scaled -e mutt -nmutt + +xterm -u8 -fn $FONT -geometry $GEOMETRY -title mutt -e mutt diff --git a/xsuspend b/xsuspend new file mode 100755 index 0000000..34e000d --- /dev/null +++ b/xsuspend @@ -0,0 +1,3 @@ +#!/bin/bash +xlock & +sudo pm-suspend |