From: Mark Wooding Date: Sun, 3 Oct 2021 14:24:02 +0000 (+0100) Subject: Merge remote-tracking branches 'crybaby/master', 'gibson/master' and 'mdwdev/master' X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/profile/commitdiff_plain/5c1771876cc5301c2d0c7e9e28c69a01682d2429?hp=f3024a0b1def9f01bb458a43bb30286f72e6867a Merge remote-tracking branches 'crybaby/master', 'gibson/master' and 'mdwdev/master' * crybaby/master: dot/swank.lisp: Only force `:fd-handler' on Lisps which can do it. dot/emacs: Add Viper cursor-colour flail. dot/emacs: Apply Viper settings as the defaults. dot/emacs, el/dot-emacs.el: Set up Viper mode. * gibson/master: firefox/stylus/Scribd Reveal.css: Hack to override Scribd sign-in bollocks. firefox/stylus/*.css: New styles for Fandom and Vridar. el/dot-emacs.el: Add a switch for the `--rebase-merges' option. dot/emacs: Move the cursor properly. * mdwdev/master: firefox/stylus/: Add styling for Trustonic's awful Confluence wiki. el/dot-emacs.el: Move the comment indentation weirdness to Alec-emulation. --- diff --git a/Makefile b/Makefile index 992fdab..be1e688 100644 --- a/Makefile +++ b/Makefile @@ -227,13 +227,6 @@ DOTLINKS += .tclshrc .wishrc .tclshrc_SRC = tclshrc .wishrc_SRC = tclshrc -## Jukebox things. -MISCLINKS += lib/perl/DisOrder.pm -lib/perl/DisOrder.pm_SRC = pl/DisOrder.pm -SCRIPTLINKS += disorder-switch-config -SCRIPTLINKS += disorder-autoplay -SCRIPTLINKS += disorder-notify - ## Random scripts. SCRIPTLINKS += mdw-editor mdw-pager SCRIPTLINKS += mdw-conf diff --git a/bin/disorder-autoplay b/bin/disorder-autoplay deleted file mode 100755 index 7b0eca3..0000000 --- a/bin/disorder-autoplay +++ /dev/null @@ -1,97 +0,0 @@ -#! /usr/bin/perl -w - -use autodie qw{:all}; -use strict; - -use DisOrder; - -(my $PROG = $0) =~ s:.*/::; - -sub grobble_dir (\@$$$); - -sub grobble_dir (\@$$$) { - my ($list, $sk, $root, $dir) = @_; - my @d; - - for my $f (send_command $sk, "files", "$root$dir") { - my ($tail) = $f =~ /\Q$root\E(.*)$/; - die "`$f' not under root `$root'" unless $tail; - push @$list, $tail; - } - - for my $d (send_command $sk, "dirs", "$root$dir") { - my ($tail) = $d =~ /\Q$root\E(.*)$/; - die "`$d' not under root `$root'" unless $tail; - push @d, $tail; - } - for my $d (@d) { grobble_dir @$list, $sk, $root, $d; } -} - -sub grobble_root ($) { - my ($sk) = @_; - my $root = undef; - my @list = (); - - for my $d (send_command $sk, "dirs", "") { - my ($pre, $tail) = $d =~ m{^(.*/)([^/]*)$}; - die "no root in `$_'?" unless $pre; - if (!defined $root) { $root = $pre; } - elsif ($root ne $pre) { die "root was `$root'; now it's `$pre'"; } - grobble_dir @list, $sk, $root, $tail; - } - return $root, \@list; -} - -sub trim_extension ($) { - my ($f) = @_; - $f =~ s/\.(flac|mp[23]|ogg|wav)$//; - return $f; -} - -sub die_usage () { - print STDERR <) { chomp; $black{$_} = 1; } - my $conf = load_config $cf; - my $sk = connect_to_server %$conf; - my ($root, $list) = grobble_root $sk; - - FILE: for my $f (sort @$list) { - my $pick = send_command $sk, "get", "$root$f", "pick_at_random"; - if (($pick // 1) eq "0") { - next FILE if $black{trim_extension $f}; - send_command $sk, "unset", "$root$f", "pick_at_random"; - print STDERR ";; reinstate <$f>\n"; - } else { - next FILE unless $black{trim_extension $f}; - send_command $sk, "set", "$root$f", "pick_at_random", 0; - print STDERR ";; blacklist <$f>\n"; - } - } - close $sk; -} diff --git a/bin/disorder-notify b/bin/disorder-notify deleted file mode 100755 index 2b0d5e8..0000000 --- a/bin/disorder-notify +++ /dev/null @@ -1,414 +0,0 @@ -#! /usr/bin/perl -w - -use autodie qw{:all}; -use strict; - -use DisOrder; -use File::FcntlLock; -use Getopt::Long qw{:config gnu_compat bundling - require_order no_getopt_compat}; -use POSIX qw{:errno_h :fcntl_h}; - -###-------------------------------------------------------------------------- -### Configuration. - -my %C = (config => "$ENV{HOME}/.disorder/passwd", - lockdir => "$ENV{HOME}/.disorder/", - mixer => "Master,0"); - -(my $PROG = $0) =~ s:^.*/::; -my $TITLE = "DisOrder"; -my $VARIANT = "default"; -if (-l $C{config} && (my $t = readlink $C{config}) =~ /^passwd\.(.*)$/) - { $VARIANT = $1; $TITLE .= " ($1)"; } - -###-------------------------------------------------------------------------- -### Random utilities. - -sub run_discard_output (@) { - my $kid = fork(); - if (!$kid) { - open STDOUT, ">/dev/null" or die "open /dev/null: $!"; - exec @_; - } - waitpid $kid, 0; - if ($?) { - my $st; - if ($? >= 256) { $st = sprintf "rc = %d", $? >> 8; } - else { $st = sprintf "signal %d", $?; } - die "$_[0] failed ($st)"; - } -} - -sub notify ($$) { - my ($head, $body) = @_; - - $body =~ s:\&:&:g; - $body =~ s:\<:<:g; - $body =~ s:\>:>:g; - - ##print "****************\n$head\n\n$body\n"; return; - - run_discard_output "notify-send", - "-c", "DisOrder", "-i", "audio-volume-high", "-t", "5000", - $head, $body; -} - -sub try_unlink ($) { - my ($f) = @_; - eval { unlink $f; }; - die $@ if $@ and $@->errno != ENOENT; -} - -###-------------------------------------------------------------------------- -### Locking protocol. - -my $LKFILE = "$C{lockdir}/disorder-notify-$VARIANT.lock"; -my $LKFH; - -sub locked_by () { - - ## Try to open the lock file. If it's not there, then obviously it's not - ## locked. - my $fh; - eval { open $fh, "<", $LKFILE; }; - if ($@) { - return undef if $@->errno == ENOENT; - die $@; - } - - ## Take out a non-exclusive lock on the lock file. - my $lk = new File::FcntlLock; - $lk->l_type(F_RDLCK); $lk->l_whence(SEEK_SET); - $lk->l_start(0); $lk->l_len(0); - if ($lk->lock($fh, F_SETLK)) { close $fh; return undef; } - - ## Read the pid of the current lock-holder. - chomp (my $pid = (readline $fh) // ""); - close $fh; - return $pid; -} - -sub claim_lock () { - sysopen my $fh, $LKFILE, O_CREAT | O_WRONLY; - - my $lk = new File::FcntlLock; - $lk->l_type(F_WRLCK); $lk->l_whence(SEEK_SET); - $lk->l_start(0); $lk->l_len(0); - if (!$lk->lock($fh, F_SETLK)) { - return undef if $! == EAGAIN; - die "failed to lock `$LKFILE': $!"; - } - - truncate $fh, 0; - print $fh "$$\n"; - flush $fh; - $LKFH = $fh; - 1; -} - -###-------------------------------------------------------------------------- -### DisOrder utilities. - -sub get_state0 ($) { - my ($sk) = @_; - my %st = (); - - LINE: for (;;) { - my @f = split_fields readline $sk; - if ($f[1] ne "state") { last LINE; } - elsif ($f[2] eq "enable_random") { $st{random} = 1; } - elsif ($f[2] eq "disable_random") { $st{random} = 0; } - elsif ($f[2] eq "enable_play") { $st{play} = 1; } - elsif ($f[2] eq "disable_play") { $st{play} = 0; } - elsif ($f[2] eq "resume") { $st{pause} = 0; } - elsif ($f[2] eq "pause") { $st{pause} = 1; } - } - return \%st; -} - -my $CONF = undef; - -sub configured_connection (;$) { - my ($quietp) = @_; - $CONF //= load_config $C{config}; - return connect_to_server %$CONF, $quietp // 0; -} - -sub get_state () { - my $sk = configured_connection; - send_command0 $sk, "log"; - my $st = get_state0 $sk; - close $sk; - return $st; -} - -sub decode_track_name ($\%) { - my ($sk, $info) = @_; - return unless exists $info->{track}; - my $track = $info->{track}; - for my $i ("artist", "album", "title") { - my @f = split_fields send_command $sk, "part", $track, "display", "$i"; - $info->{$i} = $f[0]; - } -} - -sub fmt_duration ($) { - my ($n) = @_; - return sprintf "%d:%02d", int $n/60, $n%60; -} - -sub get_now_playing ($) { - my ($sk) = @_; - my $r = send_command $sk, "playing"; - defined $r or return {}; - my %info = split_fields $r; - decode_track_name $sk, %info; - exists $info{sofar} and - $info{length} = send_command $sk, "length", $info{track}; - return \%info; -} - -sub format_now_playing (;\%) { - my ($info) = @_; - unless (defined $info) { - my $sk = configured_connection; - $info = get_now_playing $sk; - close $sk; - } - exists $info->{track} or return "Nothing."; - my $r = "$info->{artist}: ‘$info->{title}’"; - $r .= ", from ‘$info->{album}’" if $info->{album}; - exists $info->{sofar} && exists $info->{length} and - $r .= sprintf " (%s/%s)", - fmt_duration $info->{sofar}, fmt_duration $info->{length}; - $r .= "\n(chosen by $info->{submitter})" if exists $info->{submitter}; - return $r; -} - -sub watch_and_notify0 ($) { - my ($now_playing) = @_; - - my $sk = configured_connection 1; - my $sk_log = configured_connection 1; - - send_command0 $sk_log, "log"; - my $st = get_state0 $sk_log; - my $msg = "playing " . ($st->{play} ? "enabled" : "disabled"); - $msg .= "; random play " . ($st->{random} ? "enabled" : "disabled"); - $msg .= "; " . ($st->{pause} ? "paused" : "playing"); - notify "$TITLE state", "Connected: $msg"; - if ($st->{play} && $now_playing) { - my $info = get_now_playing $sk; - notify "$TITLE: Now playing", format_now_playing %$info; - } - - fcntl $sk_log, F_SETFL, (fcntl $sk_log, F_GETFL, 0) | O_NONBLOCK; - my $buffer = ""; - my @lines = (); - my $rdin = ""; vec($rdin, (fileno $sk_log), 1) = 1; - my $loss; - - WATCH: for (;;) { - for my $line (@lines) { - my @f = split_fields $line; - if ($f[1] eq "state") { - my $msg = undef; - if ($f[2] eq "disable_random") - { $st->{random} = 0; $msg = "Random play disabled"; } - elsif ($f[2] eq "enable_random") - { $st->{random} = 1; $msg = "Random play enabled"; } - elsif ($f[2] eq "disable_play") - { $st->{play} = 0; $msg = "Playing disabled"; } - elsif ($f[2] eq "enable_play") - { $st->{play} = 1; $msg = "Playing enabled"; } - elsif ($f[2] eq "pause") - { $st->{pause} = 1; $msg = "Paused"; } - elsif ($f[2] eq "resume") - { $st->{pause} = 0; $msg = "Playing"; } - notify "$TITLE state", $msg if defined $msg; - } elsif ($f[1] eq "playing") { - my %info; - $info{track} = $f[2]; - $info{submitter} = $f[3] if @f > 3; - decode_track_name $sk, %info; - notify "$TITLE: Now playing", format_now_playing %info; - } elsif ($f[1] eq "scratched") { - my %info; - $info{track} = $f[2]; - decode_track_name $sk, %info; - notify "$TITLE: Scratched by $f[3]", format_now_playing %info; - } elsif ($f[1] eq "completed" && !$st->{play}) { - notify "$TITLE state", "Stopped"; - } - } - - if (!$sk_log) { $loss = "EOF from server"; last WATCH; } - my $nfd = select my $rdout = $rdin, undef, undef, 60; - if (!$nfd) { - eval { print $sk_log "."; flush $sk_log; }; - if ($@) { $loss = "error from write: " . $@->errno; last WATCH; } - @lines = (); - } else { - READ: for (;;) { - my ($b, $n); - eval { $n = sysread $sk_log, $b, 4096; }; - if ($@ && $@->errno == EAGAIN) { last READ; } - elsif ($@) { $loss = "error from read: " . $@->errno; last WATCH; } - elsif (!$n) { close $sk_log; $sk_log = undef; last READ; } - else { $buffer .= $b; } - } - - @lines = split /\n/, $buffer, -1; - $buffer = pop @lines; - } - } - - notify "$TITLE state", "Lost connection: $loss"; - - close $sk; - close $sk_log if defined $sk_log; -} - -sub watch_and_notify ($) { - my ($now_playing) = @_; - - claim_lock or exit 1; - - for (;;) { - eval { watch_and_notify0 $now_playing; }; - $now_playing = 1; - sleep 5; - } -} - -###-------------------------------------------------------------------------- -### User-facing operations. - -my %OP; - -$OP{"volume-up"} = - sub { run_discard_output "amixer", "sset", $C{mixer}, "5\%+"; }; -$OP{"volume-down"} = - sub { run_discard_output "amixer", "sset", $C{mixer}, "5\%-"; }; - -$OP{"scratch"} = sub { - my $sk = configured_connection; - send_command $sk, "scratch"; - close $sk; -}; - -$OP{"enable/disable"} = sub { - my $st = get_state; - my $sk = configured_connection; - if ($st->{play}) { send_command $sk, "disable"; } - else { send_command $sk, "enable"; } - close $sk; -}; - -$OP{"play/pause"} = sub { - my $st = get_state; - my $sk = configured_connection; - if (!$st->{play}) { - send_command $sk, "enable"; - if ($st->{pause}) { send_command $sk, "resume"; } - } else { - if ($st->{pause}) { send_command $sk, "resume"; } - else { send_command $sk, "pause"; } - } - close $sk; -}; - -$OP{"watch"} = sub { - if (defined (my $lkpid = locked_by)) { - print STDERR "$0: already watched by pid $lkpid\n"; - exit 2; - } - watch_and_notify 1; -}; - -$OP{"now-playing"} = sub { - my $sk = configured_connection; - my $info = get_now_playing $sk; - close $sk; - print format_now_playing %$info; - print "\n"; -}; - -$OP{"notify-now-playing"} = sub { - my $sk = configured_connection; - my $info = get_now_playing $sk; - close $sk; - notify "$TITLE: Now playing", format_now_playing %$info; - unless (defined locked_by) { - fork and exit 0; - watch_and_notify 0; - } -}; - -$OP{"next-config"} = sub { - (my $dir = $C{config}) =~ s:/[^/]*$::; - my (@conf, $curr, $conf, $min); - - if (-l $C{config} && (my $t = readlink $C{config}) =~ /^passwd\.(.*)$/) - { $curr = $1; } - - opendir my $dh, +$dir; - FILE: while (my $f = readdir $dh) - { push @conf, $1 if $f =~ /^passwd\.(.*[^~])$/; } - - for (my $i = 0; $i < @conf; $i++) { - $min = $conf[$i] if (!defined $min) || $conf[$i] lt $min; - $conf = $conf[$i] - if ((!defined $curr) || $curr lt $conf[$i]) && - ((!defined $conf) || $conf[$i] lt $conf); - } - $conf = $min unless defined $conf; - - try_unlink "$dir/passwd.new"; - symlink "passwd.$conf", "$dir/passwd.new"; - rename "$dir/passwd.new", "$dir/passwd"; - notify "DisOrder configuration", "Switched to `$conf'"; -}; - -###-------------------------------------------------------------------------- -### Main program. - -sub usage (\*) { - my ($fh) = @_; - print $fh "usage: $PROG [-u CONFIG] COMMAND\n"; -} - -sub help () { - usage *STDOUT; - print < sub { help; exit 0; }, - "u|user-config=s" => \$C{config} - or $bad = 1; -@ARGV == 1 or $bad = 1; -if ($bad) { usage *STDERR; exit 2; } -my $op = $ARGV[0]; -if (!exists $OP{$op}) { print STDERR "$0: unknown op `$op'\n"; exit 2; } -$OP{$op}(); - -###----- That's all, folks -------------------------------------------------- diff --git a/bin/disorder-switch-config b/bin/disorder-switch-config deleted file mode 100755 index 86201f3..0000000 --- a/bin/disorder-switch-config +++ /dev/null @@ -1,34 +0,0 @@ -#! /bin/sh -e - -prog=${0##*/} -fail () { echo >&2 "$prog: $1"; exit 2; } -usage () { echo "usage: $prog [CONF]"; } - -bogus=nil -while getopts "h" opt; do - case $opt in - h) usage; exit 0 ;; - *) bogus=t ;; - esac -done -shift $(( $OPTIND - 1 )) -case $# in 0) op=query ;; 1) op=set conf=$1 ;; *) bogus=t ;; esac -case $bogus in t) usage >&2; exit 2 ;; esac - -cd "$HOME/.disorder" -case $op in - query) - if ! [ -L passwd ]; then link=bogus - else link=$(readlink passwd) - fi - case $link in - passwd.*) conf=${link#passwd.} ;; - *) fail "\`~/.disorder/passwd' not a link to \`passwd.CONF'" ;; - esac - echo "$conf" - ;; - set) - if ! [ -f "passwd.$conf" ]; then fail "no config \`passwd.$conf'"; fi - ln -sf "passwd.$conf" passwd - ;; -esac diff --git a/bin/remote-slideshow b/bin/remote-slideshow index 4a49a60..36d11f7 100755 --- a/bin/remote-slideshow +++ b/bin/remote-slideshow @@ -10,8 +10,8 @@ case $ok in esac dirs=$1 host=${2%:*} dpy=${2##*:}; shift 2 case $#,$1 in - 0 | 1,:slideshow) - set -- /usr/lib/xscreensaver/glslideshow -duration 60 -pan 10 \ + 0, | 1,:slideshow) + set -- /usr/lib/xscreensaver/glslideshow -duration 10 -pan 10 \ -xrm "'*desktopGrabber: ./getimg %s'" ;; 1,:photopile) diff --git a/dot/emacs b/dot/emacs index 370cfee..ad17a56 100644 --- a/dot/emacs +++ b/dot/emacs @@ -389,6 +389,8 @@ (setq-default comment-column 40) ;Set a standard comment column (setq-default truncate-partial-width-windows nil truncate-lines t) +(setq line-move-visual t + visual-order-cursor-movement t) (setq default-indicate-empty-lines t) (setq view-read-only t) (setq-default view-exit-action #'kill-buffer) @@ -423,6 +425,20 @@ '(("en_GB-ize-w_accents" "[[:alpha:]]" "[^[:alpha:]]" "'" t ("-d" "en_GB-ize-w_accents") nil utf-8)) ispell-silently-savep t) +(setq-default viper-case-fold-search t + viper-electric-mode t + viper-ex-style-motion nil + viper-ex-style-editing nil + viper-expert-level 5 + viper-inhibit-startup-message t + ;;viper-insert-state-cursor-color "red" + viper-no-multiple-ESC nil + viper-re-query-replace t + viper-re-search t + ;;viper-replace-overlay-cursor-color "red" + viper-shift-width 2 + viper-vi-style-in-minibuffer nil + viper-want-ctl-h-help t) (trap (require 'uniquify) (setq uniquify-buffer-name-style 'post-forward-angle-brackets) @@ -437,6 +453,13 @@ (tool-bar-mode 0)) (trap (or mdw-fast-startup (global-auto-revert-mode t))) +(defun mdw-set-viper-cursor-colour () + ;; ?? doesn't seem to work + (set-frame-parameter nil 'cursor-color "green") + (message ";; %S" post-command-hook) + (sit-for 2)) +;;(add-hook 'viper-vi-state-hook 'mdw-set-viper-cursor-colour) + (defvar mdw-black-background t) (eval-after-load "outline" diff --git a/dot/swank.lisp b/dot/swank.lisp index 904a984..cbac155 100644 --- a/dot/swank.lisp +++ b/dot/swank.lisp @@ -3,9 +3,9 @@ #+mdw (cl:in-package #:mdw-hacks) ;; Miscellaneous configuration. -(setf swank:*communication-style* :fd-handler - swank:*dont-close* t +(setf swank:*dont-close* t *print-right-margin* 77) +#+(or sbcl cmu) (setf swank:*communication-style* :fd-handler) ;; Maybe inhibit some Swank extensions. (let ((forbidden-contribs diff --git a/dot/zshrc b/dot/zshrc index 7a0824a..d56fde2 100644 --- a/dot/zshrc +++ b/dot/zshrc @@ -185,6 +185,7 @@ unsetopt nomatch unsetopt menu_complete setopt notify setopt rc_expand_param +setopt rc_quotes setopt share_history hash -d t=$TMPDIR diff --git a/el/dot-emacs.el b/el/dot-emacs.el index 8a0abb9..e3e1b7c 100644 --- a/el/dot-emacs.el +++ b/el/dot-emacs.el @@ -1678,6 +1678,15 @@ (mdw-define-face highlight (((class color)) :background "cyan") (t :inverse-video t)) +(mdw-define-face viper-minibuffer-emacs (t nil)) +(mdw-define-face viper-minibuffer-insert (t nil)) +(mdw-define-face viper-minibuffer-vi (t nil)) +(mdw-define-face viper-replace-overlay + (((min-colors 64)) :background "darkred") + (((class color)) :background "red") + (t :inverse-video t)) +(mdw-define-face viper-search (t :inherit isearch)) + (mdw-define-face holiday-face (t :background "red")) (mdw-define-face calendar-today-face @@ -3195,6 +3204,7 @@ (defun mdw-fontify-pythonic (keywords) ;; Miscellaneous fiddling. (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)") (setq indent-tabs-mode nil) + (set (make-local-variable 'forward-sexp-function) nil) ;; Now define fontification things. (make-local-variable 'font-lock-keywords) @@ -4977,7 +4987,9 @@ (eval-after-load "magit" magit-diff-refresh-popup magit-diff-mode-refresh-popup magit-revision-mode-refresh-popup)) - (magit-define-popup-switch popup ?R "Reverse diff" "-R")))) + (magit-define-popup-switch popup ?R "Reverse diff" "-R")) + (magit-define-popup-switch 'magit-rebase-popup ?r + "Rebase merges" "--rebase-merges"))) (defadvice magit-wip-commit-buffer-file (around mdw-just-this-buffer activate compile) diff --git a/firefox/searchplugins/startpage.xml b/firefox/searchplugins/startpage.xml new file mode 100644 index 0000000..c71ea55 --- /dev/null +++ b/firefox/searchplugins/startpage.xml @@ -0,0 +1,16 @@ + +startpage (custom) +Startpage: Search the web in complete privacy +UTF-8 + + diff --git a/firefox/stylus/Scribd Reveal.css b/firefox/stylus/Scribd Reveal.css new file mode 100644 index 0000000..1699d53 --- /dev/null +++ b/firefox/stylus/Scribd Reveal.css @@ -0,0 +1,26 @@ +/* -*-css-*- */ +/*@ urlPrefixes: https://www.scribd.com/doc/, https://www.scribd.com/document/ */ +/*@ start: */ +.autogen_class_views_pdfs_page_blur_promo { + display: none!important; +} +div.text_layer { + text-shadow: black 0 0 0!important; + -webkit-user-select: text; + -moz-user-select: text; + -ms-user-select: text; + user-select: text; +} +.page_missing_explanation { + display: none!important; +} +.trial_upsell { + display: none!important; +} +.autogen_class_views_pdfs_show.has_toolbar_nag .document_column .document_scroller { + top: 50px; +} +div.image_layer .absimg { + opacity: 1!important; +} +/*@END*/ diff --git a/firefox/stylus/fandom.com.css b/firefox/stylus/fandom.com.css new file mode 100644 index 0000000..7ba2b2e --- /dev/null +++ b/firefox/stylus/fandom.com.css @@ -0,0 +1,4 @@ +/* -*-css-*- */ +/*@ domains: fandom.com */ +body { overflow: scroll !important; } +/*@END*/ diff --git a/firefox/stylus/vridar.org.css b/firefox/stylus/vridar.org.css new file mode 100644 index 0000000..e5bd41b --- /dev/null +++ b/firefox/stylus/vridar.org.css @@ -0,0 +1,13 @@ +/* -*-css-*- */ +/*@ domains: vridar.org */ +a:hover { border: 0 !important; } +.tagcloud a:hover { border: solid 1px !important; } +a:visited { color: #0000d8 !important; } +a:link, a:hover { color: #007ac8 !important; } +.site-content { font-size: inherit; } +body { font-family: serif; } +h1, h2, h3, h4, h5, h6 { + font-family: sans-serif; + font-weight: bold; +} +/*@END*/ diff --git a/pl/DisOrder.pm b/pl/DisOrder.pm deleted file mode 100644 index ab609b3..0000000 --- a/pl/DisOrder.pm +++ /dev/null @@ -1,190 +0,0 @@ -### -*-perl-*- - -use autodie qw{:all}; -use strict; - -use Digest::SHA; -use Exporter qw{import}; -use Socket qw{:DEFAULT :addrinfo}; - -our @EXPORT_OK = qw{get_response0 decode_response get_response - send_command0 send_command - split_fields - load_config connect_to_server}; - -use Data::Dumper; - -sub split_response_code ($) { - my ($st) = @_; - my $c = $st%10; $st = int($st/10); - my $b = $st%10; $st = int($st/10); - my $a = $st; - return ($a, $b, $c); -} - -sub get_response0 ($) { - my ($sk) = @_; - (my $st, my $r) = split ' ', (readline $sk), 2; - chomp $r; - - my ($a, $b, $c) = split_response_code $st; - if ($a == 5) { - if ($c == 5) { return $st, undef; } - else { die "server error: $r"; } - } - elsif ($a != 2) { die "unexpected status code $a"; } - else { return $st, $r; } -} - -sub decode_response ($$$) { - my ($sk, $st, $r) = @_; - my ($a, $b, $c) = split_response_code $st; - - if ($c == 0 || $c == 5 || $c == 9) { return undef; } - elsif ($c == 1 || $c == 2) { return $r; } - elsif ($c == 3) { - my @r = (); - LINE: for (;;) { - chomp (my $line = readline $sk); - last LINE if $line eq "."; - $line =~ s/^\.//; - push @r, $line; - } - return @r; - } else { die "unexpected format code $c in $st"; } -} - -sub get_response ($) { - my ($sk) = @_; - my ($st, $r) = get_response0 $sk; - return decode_response $sk, $st, $r; -} - -sub send_command0 ($@) { - my ($sk, @f) = @_; - - my $t = ""; - for my $f (@f) { - if ($f eq "" || $f =~ /[\\"'\s]/) { - $f =~ s/([\\"])/\\$1/g; - $f = '"' . $f . '"'; - } - $t .= " " if $t; - $t .= $f; - } - print $sk "$t\n"; - return get_response0 $sk; -} - -sub send_command ($@) { - my ($sk, @f) = @_; - my ($st, $r) = send_command0 $sk, @f; - return decode_response $sk, $st, $r; -} - -sub split_fields ($) { - my ($l) = @_; - my @f = (); - my $f; - - FIELD: for (;;) { - $l =~ s/^\s*//; - last FIELD if $l eq ""; - if ($l =~ /^(["'])/) { - my $q = $1; - ($f, $l) = $l =~ /^ $q ((?: [^\\$q]+ | \\ .)* ) $q (.*) $/x; - $f =~ s/\\(.)/$1/g; - } else { - ($f, $l) = split ' ', $l, 2; $l //= ""; - } - push @f, $f; - } - return @f; -} - -sub load_config ($) { - my ($conf) = @_; - my %conf = (connect => ["-unix", "/var/lib/disorder/socket"]); - - open my $fh, "<", $conf; - LINE: while (<$fh>) { - chomp; - next LINE unless /^\s*[^\s#]/; - (my $k, my @f) = split; - $conf{$k} = \@f; - } - close $fh; - for my $i (qw{ username password }) - { die "missing configuration keyword `$i'" unless exists $conf{$i}; } - return \%conf; -} - -sub connect_to_server (\%;$) { - my ($conf, $quietp) = @_; - my @f; - - my $af = AF_UNSPEC; - my @a = $conf->{connect}->@*; - die "empty address" unless @a; - if ($a[0] eq "-unix") { $af = AF_UNIX; shift @a; } - elsif ($a[0] eq "-4") { $af = AF_INET; shift @a; } - elsif ($a[0] eq "-6") { $af = AF_INET6; shift @a; } - elsif ($a[0] eq "-") { shift @a; } - die "empty address" unless @a; - - my $a; - my @i; - if ($af == AF_UNIX || ($af == AF_UNSPEC && $a[0] =~ m{^/})) { - @i = ({ family => AF_UNIX, addr => pack_sockaddr_un($a[0]) }); - shift @a; - } else { - die "missing port" unless @a >= 2; - (my $e, @i) = getaddrinfo $a[0], $a[1], - { family => $af, socktype => SOCK_STREAM }; - die "getaddrinfo (host `$a[0]', service `$a[1]'): $e" if $e; - splice @a, 0, 2; - } - die "junk in address" if @a; - - my $sk; - my @e; - ADDR: for my $i (@i) { - eval { - socket $sk, $i->{family}, SOCK_STREAM, 0; - connect $sk, $i->{addr}; - }; - last ADDR unless $@; - close $sk if defined $sk; - push @e, $@->errno; - $sk = undef; - } - - unless (defined $sk) { - die "failed to connect" if $quietp; - print STDERR "failed to connect!\n"; - for (my $i = 0; $i < @i; $i++) { - if ($i[$i]{family} == AF_UNIX) - { $a = unpack_sockaddr_un $i[$i]{addr}; } - else { - my ($e, $host, $svc) = getnameinfo $i[$i]{addr}, - NI_NUMERICHOST | NI_NUMERICSERV; - die "getnameinfo: $e" if $e; - $a = $host . ":" . $svc; - } - print STDERR "\t$a: $e[$i]\n"; - } - die "giving up"; - } - autoflush $sk 1; - - @f = split_fields get_response $sk; - die "expected version 2" unless $f[0] eq "2"; - my $h = Digest::SHA->new($f[1]); - $h->add($conf->{password}[0], pack "H*", $f[2]); - my $d = $h->hexdigest; - send_command $sk, "user", $conf->{username}[0], $d; - - return $sk; -} - -1;