#!/usr/bin/env ruby
# Catch up with conversation on email
# - Dynamic mailing list and more for qmail -
# http://www.gentei.org/~yuuji/software/catchup/
# $Id:$
# Last modified Wed Nov 19 06:55:14 2008 on firestorm
# Update count: 264
# (c)2008 by HIROSE, Yuuji [yuuji@yatex.org]

ENV["PATH"] = "/var/qmail/bin:/usr/sbin:"+ENV["PATH"]+":/usr/lib"

$prefix	= "#:"
$repl	= nil
$rcpt	= ENV['RECIPIENT']
$header	= {'Reply-to' => $rcpt}
$confdir= "~/."+File.basename($0).sub(".rb", "")
$expire	= 7*24*3600
$expire	= 400
$sender	= ENV["SENDER"]
$subject=''
$fromhack	= nil
$subjecthack	= nil
$verpsep	= '='
$dotqmaildir	= nil
$commandmode	= nil
$unsubscribe	= nil
$staticmember	= nil

require 'kconv'
require 'nkf'			# for MIME encoding
class GuestDB
  def initialize(dir)
    @dir = File.expand_path(dir)
    @modemask = 0100
    parent = File.dirname(@dir)
    Dir.mkdir(parent, 0750) unless test(?d, parent)
    Dir.mkdir(@dir, 0750) unless test(?d, @dir)
  end
  def item2file(item)
    File.expand_path(item, @dir)
  end
  def mkitem(item, comment = nil)
    file=item2file(item)
    File.unlink(file) if test(?f, file)
    open(file, "w"){|fp| fp.puts comment if comment&&comment>""}
  end
  def delitem(item)
    file=item2file(item)
    File.unlink(file)
  end
  def listall()
    Dir.entries(@dir).select{|f| /@/=~f}.sort
  end
  def list()
    listall.select{|f|
      file = @dir+"/"+f
      File.stat(file).mode&@modemask == 0
    }
  end
  def turnoff(file)
    # File.unlink(file)
    mode = File.stat(file).mode
    printf("%s: %o -> %o\n", file, mode, mode|@modemask) if $DEBUG
    File.chmod(mode|@modemask, file)
  end
  def postonly(expire)
    limit = Time.now-expire
    list.select {|f|
      file = @dir+"/"+f
      if File.mtime(file) < limit
	turnoff(file)
	f
      end
    }
  end
  def update(item)
    #mkitem(item)
    file = item2file(item)
    mode = File.stat(file).mode
    newmode = mode&~@modemask
    printf("%s: %o -> %o\n", file, mode, newmode)
    File.chmod(newmode, file)
  end
  def downdate(item)
    turnoff(@dir+"/"+item)
  end
  def delete(item)
    file = item2file(item)
    File.unlink(file) if test(?f, file)
  end
  def escape(string)		# borrowed from cgi.rb
    string.gsub(/([^a-z0-9_.-]+)/ni) do
      '%' + $1.unpack('H2' * $1.size).join('%').upcase
    end
  end

  def unescape(string)
    string.tr('+', ' ').gsub(/((?:%[0-9a-fA-F]{2})+)/n) do
      [$1.delete('%')].pack('H*')
    end
  end
  def setvalue(k, v)
    newk, newv = escape(k), escape(v)
    file = item2file(newk)
    File.unlink(file) if test(?f, file)
    open(file, "w"){|f| f.print newv}
    v				# return itself
  end
  def getvalue(k)
    newk = escape(k)
    file = item2file(newk)
    if test(?s, file) then
      unescape(IO.readlines(file).join.split("\n").join(" "))
    else
      ""
    end
  end
  def setheader(header, value)
    setvalue(header.capitalize, value)
  end
  def getheader(header)
    getvalue(header.capitalize)
  end
  def setcomment(item, comment)
    mkitem(item, comment)
  end
  def getcomment(item)
    file=item2file(item)
    comment = nil
    if test(?s, file) then
      open(file, "r"){|fp| comment=fp.gets.chomp}
      return comment if comment && comment > ""
    end
    return nil
  end
end

class Dotqmail
  def initialize(local, domain)
    @c = "/var/qmail/control"
    @user = local
    @dash = "-"
    @pre = ""
    vd = File.expand_path("virtualdomains", @c)
    if ! test(?s, vd) \
      || ! IO.readlines(File.expand_path("locals", @c)).select{|x|
	x.chomp!
	domain == x || Regexp.new("^"+Regexp.quote(x)+'$') =~ domain # '$
      }.empty? then
      if ENV['POSTFIX'] || test(?d, "/etc/postfix")
	d = (ENV['POSTFIX'] || "+")
	@user, @ext = @user.split(d, 2)
	@ext = "-"+@ext
	require 'etc'
	@home = Etc.getpwnam(@user).dir
	return
      end
    elsif test(?s, vd)
      vdoms = IO.readlines(vd)
      d = domain
      u = nil
      while d > ""
	match = vdoms.select{|x| /^#{d}:/ =~ x}[0]
	if match then
	  d, u = match.chomp.split(":")
	  break
	end
	d.sub!(/\.?[^.]+/, "")
      end
      @user = u+"-"+local
    end
    @home = gethome(@user)
  end
  def gethome(user)
    return "" unless user
    home = nil
    if test(?r, asg="/var/qmail/users/assign") then
      assignlist = IO.readlines(asg)
      u = user.dup
      while u > ""
	@ext = user[u.length..-1]
	ux = Regexp.quote(u)
	match = assignlist.select{|l| /^\+#{ux}-:/ =~ l}[0]
	if match then
	  ms = match.chomp!.split(":", -1)
	  home = ms[4]
	  @dash = ms[5]
	  @pre = ms[6]
	  break
	end
	u.sub!(/-?[^-]+$/, "")
      end
      return home if home
    end
    u = user.dup
    require 'etc'
    while u > ""
      @ext = user[u.length..-1].to_s
      begin
	home = Etc.getpwnam(u).dir
      rescue
      end
      u.sub!(/-?[^-]+$/, "")
    end
    # if a user is found, return its home directory
    if home then
      return home
    else
      # no users found, then it's covered by user `alias'
      begin
	home = Etc.getpwnam("alias").dir
	@ext = "-"+user
      rescue
      end
    end
    return home || ""
  end
  def homedir()
    @home
  end
  def dotqmail()
    @home+"/.qmail"+@pre+@ext
  end
end

def install()
  e = STDERR
  while true
    e.print <<_EOF_
連絡先として使いたいアドレスを入れて下さい(例: taro-renraku@example.com)
_EOF_
    e.print "Mail Address for broadcasting: "
    address = gets.chomp!
    local, domain = address.split("@")
    local and domain and break
  end
  dq = Dotqmail.new(local, domain).dotqmail
  homedir = File.dirname(dq)
  # p dq.homedir, dq.dotqmail()
  if test(?f, dq) then
    e.print "#{dq} ファイルは既に存在します。上書きしますか?(y/n)\n"
    e.print "#{dq} alread exists.  Continue(y/n): "
    abort "中止します。" if /^y/i !~ gets
  end
  e.puts "このアドレスのメンバーにしたい宛先を順次入力して下さい(xで終了)。"
  e.puts "Enter members' email addresses for this address."
  require 'resolv'
  dns = Resolv::DNS.new
  members = []
  while true
    e.print "Address(enter `x' for break): "
    email = gets.chomp!
    break if /^(x|\`x')$/i =~ email
    redo unless /@/ =~ email
    local, domain = parseaddress(email)[0].split("@")
    begin
      dns.getresource(domain, Resolv::DNS::Resource::IN::ANY)
    rescue
      e.print "#{e} というメイルドメインはみつかりません.\n"
      e.print "#{e} is nonexistent mail domain.\n"
      redo
    end
    e.print "[#{email}] added\n"
    members << $prefix+" "+email
  end
  e.puts "必ず返事が全員に戻るようなFrom:ヘッダの書き換えをしますか?"
  e.puts "Do you need From:-header hack to ensure reply comes back to all?"
  e.print "(y/n): "
  fromopt = (/^y/i =~ gets ? "-F " : "")
  e.puts "Subjectをまともなものに保つよう努力させますか??"
  e.puts "Shall I try to keep Subject: sane even if they drop it?"
  e.print "(y/n): "
  subjopt = (/^y/i =~ gets ? "-S " : "")
  e.puts "デフォルトは自動登録ですが、そうせず固定メンバーにしますか??"
  e.puts "Auto subscription by default.  Stop it and serve as simple alias?"
  e.print "(y/n): "
  staticopt = (/^y/i =~ gets ? "-s " : "")
  if %r,/, !~ $0 then
    # no slashes
    myname = `which $0`.chomp
    myname.sub!(homedir, ".")
  else
    myname = File.expand_path($0)
    myname.sub!(homedir, ".")
  end
  while true
    if $dotqmaildir && test(?d, $dotqmaildir)
      dir = $dotqmaildir
    else
      e.print "書き出すファイル名は?\n"
      e.print "Specify the file name of dot-qmail.\n"
      e.printf("(Default %s): ", dq)
      newdq = gets.chomp
      break if newdq == ""
    end
    if test(?d, File.dirname(newdq)) && test(?w, File.dirname(newdq))
      dq = newdq
      break
    else
      e.puts "存在するディレクトリのファイル名を指定して下さい"
      e.puts "Input file name in the existing directory."
    end
  end
  content = ["| #{myname} #{fromopt}#{subjopt}#{staticopt}-r #{address}"]
  output = (content+members).join("\n")
  e.puts "\n以下の内容で #{dq} を作成しました。"
  e.puts "-"*78+"\n"+output+"\n"+"-"*78+"\n"
  dqbase, dqdir = File.basename(dq), File.dirname(dq)
  open(dq, "w") do |dqf|
    dqf.puts output
  end
  # Return 
  admindq = File.expand_path(dqbase+"-adm-default", dqdir)
  adminline = "| #{myname} -r #{address} -u"
  # printf("ln -s %s %s\n", dqbase, admindq) if $DEBUG
  open(admindq, "w") do |adq| adq.puts(adminline) end
  e.puts "\nまた以下の内容で #{admindq} を作成しました。"
  e.puts "-"*78+"\n"+adminline+"\n"+"-"*78+"\n"
  e.print "#{dq} ファイルの1行目の\n#{$0}\n"
  e.print "が適切でない場合は正しいパスに直しておいて下さい\n"
  e.print "At the 1st line of #{dq},\nyou see a filename as follows;\n"
  e.print " #{$0}\n"
  e.print "You may have to replace this with correct pathname.\n"
  exit 0
end

def convunit(s)
  case s
  when /y$/
    s.to_i * 365*24*3600
  when /m$/
    s.to_i * 30*24*3600
  when /w$/
    s.to_i * 7*24*3600
  when /d$/
    s.to_i * 24*3600
  when /h$/
    s.to_i * 3600
  else
    s.to_i
  end
end

def splitaddresses(line)
  list = []
  l = 0
  inquote = nil
  while l<line.length
    r = l-1
    while r<line.length
      r += 1
      if inquote
	case line[r]
	when ?\\
	  r+=1
	  next
	when ?\"  #"
	  inquote = false
	  next
	end
      else
	case line[r]
	when ?\\
	  r+=1
	  next
	when ?\" #"
	  inquote = true
	  next
	when ?,
	  break
	end
      end
    end
    list << line[l..r-1].strip
    l = r+1
  end
  list
end

def parseaddress(spec)
  # Return [email, comment]
  # nil if comment does not exitst.
  if /(.*)\s*<(.*)>/ =~ spec then
    [$2, $1.strip]
  elsif /(.*)\s*\((.*)\)/ =~ spec then
    [$1.strip, $2]
  else
    [spec.strip, nil]
  end
end

def extractrcpt(line, addresswithoutVERP)
  local, domain = addresswithoutVERP.split("@")
  lrx = Regexp.new("^"+Regexp.quote(local)+'-')
  drx = Regexp.new("@"+Regexp.quote(domain)+'$') # '
  info = {}

  splitaddresses(line).each {|a|
    e, n = parseaddress(a)
    # If extracted address seems to be a VERP address of this address
    # it should be rewritten to my address without VERP.
    e = addresswithoutVERP if lrx =~ e && drx =~ e
    info[e] = n
  }
  info
end

while /^-.+/ =~ ($_=ARGV[0])
  $_=ARGV.shift.dup
  break if ~/^--$/
  while ~/^-[A-z]/
    case $_
    when "-install"
      install
    when "-t"
      extractrcpt(gets.chomp, "yuuji-all@gentei.org")
    when "-e"
      $expire = convunit(ARGV.shift)
    when "-F"
      $fromhack = true
    when "-s"
      $staticmember = true
    when "-S"
      $subjecthack = true
    when "-d"
      $dotqmaildir = ARGV.shift
    when "-h"
      if /([^=]+)=(.*)/ =~ ARGV.shift then
	$header[$1] = $2
      else
	STDERR.print "Value for -h options should be the form of\n"
	STDERR.print "header=value\n"
	exit 1
      end
      break
    when "-r"
      $header['Reply-to'] = $rcpt = ARGV.shift; break
    when "-f"
      $repl = true
    when "-u"
      $unsubscribe = true
    else
      ARGV.shift; break
    end
    $_.sub!(/^-.(.*)/, "-\\1")
  end
end
g = GuestDB.new($confdir+"/"+$rcpt)

if !$rcpt then
  STDERR.print "Recipient unkown.\nUse -r RecipientAddress\n"
  exit 1
end

def headervalue(line)
  line.sub(/^[^:]+:\s*/, "").chomp
end
class HeaderOP
  # This class is awkward workaround for using common db.
  def initialize(db = GuestDB.new)
    @db = db
  end

  def cachesubject(new)
    @db.setheader("Subject", new)
  end

  def oldsubject()
    o = @db.getheader("Subject").sub(/^(re([\[0-9\]:]) ?)+/i, "")
    o = "Re: "+o if o > ""
    o
  end
  def bettersubject(current)
    oldsbj = oldsubject().toeuc
    # remove superfluous re:re:re:... or Re[3]:...
    newsbj = current.sub(/^(re(\[?[0-9]?\]?) ?: ?)+/i, "Re: ")
    if /^$|^(re(\[[0-9]\]| )?:? ?)+$/i =~ newsbj
      # if Subject is empty or meaningless, use cached Subject.
      newsbj = oldsbj
    end
    newsbj = Time.now.strftime("%m-%d") if newsbj == ""
    cachesubject(newsbj) if oldsbj != newsbj
    newsbj
  end
end
hop = HeaderOP.new(g)

def mkverp(rcpt, myaddress)
  local, domain = myaddress.split("@")
  local+"-"+rcpt.sub("@", $verpsep)+"@"+domain
end
def unverp(rcpt, myaddress)
  rlocal, rdomain = rcpt.split("@")
  mylocal, mydomain = myaddress.split("@")
  rlocal.sub("^"+Regexp.quote(mylocal)+"-", "") + mydomain
end
def replat(address)
  address.sub("@", $verpsep)
end

def rewritefrom(email, comment, newseed, g)
  # Assume from header has only one address spec
#   case orig
#   when /(\"?)(.*)(\1)<(.*)>/
#     ## return $1+"<"+mkverp($2, newseed)+">"
#     if $2 then
#       comment, email, quote = $2, $4, $1
#       return quote+comment+" "+replat(email)+quote+"<"+newseed+">"
#     else
#       email = $4
#       /(\"?)(.*)(\1)/ =~ g.getcomment(email)
#       return $1+$2+" "+replat(email)+$3+"<"+newseed+">"
#     end
#   when /(.*) \((.*)\)/
#     ## return mkverp($1, newseed)+" (#{$2})"
#     comment, email = $1, $2
#     return "\"#{comment} #{replat(email)}\" <"+newseed+">"
#   else
    ## return mkverp(orig, newseed)
  comment = comment||g.getcomment(email)||""
  # no need to setcomment here because if comment set, it's enough
  comment.sub!(/(\"?)(.*)\1/, '\2')
  comment += "/" if comment>""
  return comment.sub(/([\x80-\xff]+)/){NKF.nkf('-M', $1)} +
    replat(email)+" <"+newseed+">"
#  end
end

def getrcpt()
  info = {}
  dq = ".qmail"
  dq += "-"+ENV["EXT"] if ENV["EXT"]
  if ENV["DEFAULT"] && ENV["DEFAULT"] > ""
    dq.sub!("-"+ENV["DEFAULT"], "")
  end
  dq = File.expand_path(dq, ENV["HOME"])
  if test(?s, dq) then
    IO.readlines(dq).select {|x|
      /^#{$prefix}/ =~ x
    }.each {|x|
      # strip prefix and remove trailing comment string
      e, c = parseaddress(x.sub(/^#{$prefix}\s*/, "").sub(/\s*\#.*$/, ""))
      info[e] = c
    }
  end
  info
end

###
# Main procedure
###
if $unsubscribe
  default = ENV["DEFAULT"]
  user = default.sub($verpsep, "@")
  g.delete(user)
  if (owner=g.getvalue("Owner")) then
    open("| sendmail -f#{$rcpt} #{owner}", "w") do |rep|
      rep.print "From: #{$rcpt}
To: #{owner}
Subject: Member Removed: #{user}

Removed #{user} from #{$rcpt}
because of delivery failure.\n".tojis
    end
  end
  exit 0
end

body = []
hold = []
msghead = ["Delivered-To: #{$rcpt}\n"]
header=''
rcptinheader = []
userinfo = {}
$header["Subject"] = hop.oldsubject

if ARGV[0] then
  regularmember = ARGV
else
  userinfo = getrcpt()
  regularmember = userinfo.keys
end

while line=STDIN.gets
  # break if /^$/ =~ line
  if /^([a-z][-a-z]*):|^$/i =~ line
    cur = $1
    if !hold.empty? then
      header = hold[0].split(":")[0]
      if /^(to|cc)$/i =~ header then
	newinfo = extractrcpt(headervalue(hold.join), $rcpt)
	userinfo.update(newinfo)
	rcptinheader += newinfo.keys
	if $fromhack then
	  
	end
      elsif /^subject$/i =~ header then
	# bye|off|chaddr
	subj = headervalue(hold.join).chomp
	if /^(member|who|off|bye)$/i =~ subj.strip
	  $commandmode = $1
	else
	  subj = hop.bettersubject(subj) if $subjecthack
	  $subject = subj		# for latter use
	  hold = ["Subject: "+subj+"\n"]
	end
      elsif $fromhack && /^from$/i =~ header then
	# From should be 1 entry.
	email, comment =
	  parseaddress(splitaddresses(headervalue(hold.join))[0])
	userinfo[email] = comment if comment
	hold = ["From: "+rewritefrom(email, userinfo[email], $rcpt, g)+"\n"]
      end
      for h in $header.keys
	if h.downcase == header.downcase then
	  hold = ["#{h}: #{$header[h]}\n"] if $repl
	  $header.delete(h)
	  break
	end
      end
      if !cur
	for h in $header.keys
	  hold << "#{h}: #{$header[h]}\n"
	end
	hold << "\n"		# delimiter with mail body
      end
    end
    msghead += hold
    break unless cur
    hold = []
  end
  hold << line
end

skipped = g.postonly($expire)
# guest := all recipients in header except static member and this list
guest = rcptinheader-regularmember-[$rcpt]

if $commandmode
  recipients = [$sender]
  hrule = "-"*60+"\n"
  msghead = [
    "To: #{$sender}
Subject: #{$commandmode} result from #{$rcpt}
From: Command result <#{$rcpt}>
Date: #{Time.now.to_s}
Reply-To: #{$rcpt}\n"
  ]
  case $commandmode
  when /member|who/
    contents = msghead +
      ["Member(s) of #{$rcpt}\n", hrule] +
      regularmember.collect{|n| "* "+n+"\n"} +
      g.list.collect{|n| "- "+n+"\n"} +
      [hrule, "* Core member (固定メンバー)\n".tojis,
      g.list.empty? ? "" : "- Guest(自動登録メンバー)\n".tojis ]
  when /off/
    if g.list.index($sender) then
      g.downdate($sender)
      contents = msghead + [
	"Stopped auto-mailing until you send to #{$rcpt}.\n",
	"次にあなたが #{$rcpt} にメイルを送るまで配送を停止します。\n".tojis
      ]
    else
      contents = msghead + [
	"You are not guest of #{$rcpt}.\n",
	"あなたは自動登録メンバーではありません。\n".tojis
      ]
    end
  end
else				# not command mode
  g.update($sender) if g.listall.index($sender)
  recipients = regularmember + g.list
  body = STDIN.readlines

  if !skipped.empty? then
    body << "\n"+"="*30+"\n"
    body << "Old Member marked skip: "+skipped.join(", ")+"\n"
    body << "="*30+"\n"
  end
  # Update user information
  guest.each{|i|
    info = userinfo[i] 
    if info && info > "" then
      g.setcomment(i, info)
    end
  }
  if g.list.index($sender) && userinfo[$sender] && userinfo[$sender] > ""
    g.setcomment($sender, userinfo[$sender])
  end
  # Send participation guidance
  if !$staticmember && !guest.empty? && recipients.index($sender) then
    timeout = if $expire > 3600*24 then
		($expire/3600/24).to_s + " days"
	      elsif $expire > 3600 then
		($expire/3600).to_s + " hours"
	      else
		$expire.to_s + " seconds"
	      end
    timeoutj =
      timeout.sub(" days", "日").sub(" hours", "時").sub(" seconds", "秒")
    guest.each{|i|
      g.mkitem(i, userinfo[i]) # Add to dynamic member list
      # open("| qmail-inject -f #{$rcpt} -- #{i}", "w") {|w|
      open("| sendmail -f #{$rcpt} #{i}", "w") {|w|
	w.puts <<_EOF_.tojis
To: #{userinfo[i]} <#{i}>
Reply-to: #{$rcpt}
Delivered-to: #{$rcpt}
From: #{$rcpt}
Subject: You are added to #{$rcpt}

(Japanese below. 日本語の説明は下の方)
You(#{i}) are
added to mail list as a consequent of previous mail from
"#{$sender}".
Current member list is added at the bottom of this mail.
You will be automatically unsubscribed from this list after #{timeout}
without any response to the list.
If you send email this address with
  Subject: member	... to get member list
  Subject: off		... to turn off mailing to you

Thank you.

直前に届いた(はずの)
"#{$sender}" さんからのメイルによってあなたのこの
アドレス(#{i})は、
#{$rcpt} というアドレスのリストに追加されました。
以後、このアドレスに返事を送るとメンバー全員に届きます。ただし、
#{timeoutj}間あなたからの送信がなければ自動的にリストから解除されます。
この宛先に Subject(件名)を、
member		にして送ると現在のメンバーリストが送られて来ます。
off		にして送るとあなた宛の配送をOFFにします。
また、このリストに、現在メンバーでない人も追加したい場合は、
#{i} とその人両方宛にメイルを送って下さい。その人も自動登録され、
今の話題に参加できます。

詳しくは http://www.gentei.org/~yuuji/software/catchup/ を御覧あれ。
_EOF_
        w.print "現在のメンバーは\n ".tojis
        w.puts((recipients+guest).uniq.join("\n "))
        w.print "です\n".tojis
      }
    }
    body << "\n"+"="*30+"\n"
    body << "New Member Added: "+guest.join(", ")+"\n"
    body << "="*30+"\n"
  end
  contents = msghead + body
end
open("/tmp/raw2", "w") do |raw|
  raw.print contents.join
end if $DEBUG

if ENV["RPLINE"] then
  # ENV["QMAILINJECT"] = "r"
  tee = $DEBUG ? "tee /tmp/#{myname}-out |" : ""
  admin, domain = $rcpt.split("@")
  admin = admin+"-adm@"+domain
  for r in recipients
    verp = mkverp(r, admin)
    # open("| #{tee}qmail-inject -f #{verp} -- "+r, "w") do |out|
    open("| #{tee}sendmail -f #{verp} -- "+r, "w") do |out|
      if /@(docomo|ezweb|softbank|(.*\.)?pdx)\.ne.jp/ =~ r
	# for foolish cellular MUA, hack To: address towards to itself.
	i = 0
	while i<msghead.length
	  if /^To:/ =~ msghead[i]
	    out.printf("To: %s\n", r)
	    i+=1; i+=1 while i<msghead.length && /^[ \t]/ =~ msghead[i]
	    next
	  end
	  out.print msghead[i]
	  i+=1
	end
	out.print body
      else
	out.print contents
      end
    end
  end
else
  STDOUT.print contents
end