DouKaku?

module Main (main) where

import Data.Char
import Data.List
import Data.Maybe
import Text.HTML.TagSoup

-- Parsing
-- Text.HTML.TagSoup.parseTags :: String -> [Tag Char]

-- Translating
translate :: [Tag Char] -> [Tag Char]
translate = concatMap trans

trans :: Tag Char -> [Tag Char]
trans tag = case tag of
  TagOpen t attrs | ignore t  -> [escapeTagOpen t attrs]
                  | otherwise -> [TagOpen t (filterAttr t attrs)]
  TagClose t      | ignore t  -> [escapeTagClose t]
  TagText s -> concat $ intersperse [TagOpen "br" [], TagClose "br"]
             $ map ((:[]) . TagText) $ lines s
  _                           -> [tag]

ignore :: String -> Bool
ignore = flip notElem (map fst filterTable) . map toLower

escapeTagOpen t attrs
 = TagText $ "<"++t++escape (' ':unwords (map showAttr attrs))++">"
escapeTagClose t
 = TagText $ "</"++t++">"

filterAttr :: String -> [Attribute Char] -> [Attribute Char]
filterAttr t = filter ((maybe (const True) id (lookup t filterTable)) . fst)

filterTable :: [(String,String->Bool)]
filterTable = [("a",flip elem ["href","name"])
	      ,("strong",const False)
	      ,("br",const False)]

-- Showing

showTags :: [Tag Char] -> String
showTags [] = ""
showTags (TagOpen s [] : TagClose e : ts) | isEmptyTag s && s == e
 = angle (s ++"/")++showTags ts
showTags (TagOpen s attrs : TagClose e : ts) | isEmptyTag s && s == e
 = angle (s ++ ' ':unwords (map showAttr attrs)++"/")++showTags ts
showTags (TagOpen s [] : ts) | isEmptyTag s 
 = angle (s ++"/")++showTags ts
showTags (TagOpen s attrs : ts) | isEmptyTag s 
 = angle (s ++ ' ':unwords (map showAttr attrs)++"/")++showTags ts
showTags (t:ts) 
 = showTag t ++ showTags ts

showTag tag = case tag of
  TagOpen t attrs -> angle $ t ++ ' ':unwords (map showAttr attrs)
  TagClose t      -> angle $ t ++ "/"
  TagText s       -> s
  TagComment c    -> angle $ "!--" ++ c ++ "--"
  TagSpecial s t  -> angle $ "!" ++ s ++ ' ':t
  TagWarning s    -> ""

angle :: String -> String
angle s = "<"++s++">"

isEmptyTag :: String -> Bool
isEmptyTag = flip elem ["br","hr"]     -- not full fledged

showAttr :: Attribute Char -> String
showAttr (a,v) = a ++ "=" ++ q v
  where q v = if elem sq v then dq:v++[dq]
              else sq:v++[sq]
        sq = '\''
        dq = '\"'

escape :: String -> String
escape = concatMap esc
 where esc '<' = "&lt;"
       esc '>' = "&gt;"
       esc '&' = "&amp;"
       esc c   = [c]

--

main :: IO ()
main = do { putStrLn . showTags . translate . parseTags $ testdata1
	  ; putStrLn . showTags . translate . parseTags $ testdata2
          ; putStrLn . showTags . translate . parseTags $ testdata3
          ; putStrLn . showTags . translate . parseTags $ testdata4
	  }

testdata1 = "<script foo=\"<script>alert('bar')</script>\">alert('foo')</script>"
testdata2 = "<script foo=\"<a href='link'>link</a>\">alert('foo')</script>"
testdata3 = "<a href='www.g>oogle.com'>link</a>"
testdata4 = "<a\n href='www.google.com'>link<!-- comment --></a> This<br> is an\n example."

{-
*Main> :main
&lt;script foo="&lt;script&gt;alert('bar')&lt;/script&gt;"&gt;alert('foo')&lt;/script&gt;
&lt;script foo="&lt;a href='link'&gt;link&lt;/a&gt;"&gt;alert('foo')&lt;/script&gt;
<a href='www.g>oogle.com'>link<a/>
<a href='www.google.com'>link<!-- comment --><a/> This <br/> is an<br/> example.
-}

<?php
function safehtml($str)
{
	$safetag=array('a'=>array(1,array('href','name')),'strong'=>array(1),'br'=>array(2));
	$r=array();
	$tags=array();
	$offs=0;
	while(preg_match('!<(\s*(/|)\s*(([^>\'"/]+|\'[^\']*\'|"[^"]*")*)(/|)\s*)>!',$str,$m1,PREG_OFFSET_CAPTURE,$offs))
	{	$r[]=nl2br(substr($str,$offs,$m1[0][1]-$offs));
		$offs=$m1[0][1]+strlen($m1[0][0]);
		preg_match_all('!([^\s\'"=]+)(\s*=\s*("[^"]*"|\'[^\']*\'|[^\s]+)|)!im',$m1[3][0],$m2,PREG_SET_ORDER);
		$tag=strtolower($m2[0][1]);
		if(isset($safetag[$tag]))
		{	if($safetag[$tag][0]&1)
			{	if($m1[2][0])
				{	if(array_search($tag,$tags)===false)
						continue; // 開いてないタグは閉じない
					while(($t=array_shift($tags))) // 開いたのと逆順に閉じる
					{	$r[]="</$t>";
						if($t==$tag)
							break;
					}
					continue;
				}
				if(!$m1[5][0])
					array_unshift($tags,$tag);
			}
			if($safetag[$tag][0]&2)
			{	$m1[2][0]="";
				$m1[5][0]="/";
			}
			$t=array($tag);
			if(isset($safetag[$tag][1]) && !$m1[2][0])
			{	array_shift($m2);
				while($param=array_shift($m2))
				{	if(array_search(strtolower($param[1]),$safetag[$tag][1])!==false)
						$t[]=$param[0];
				}
			}
			$r[]='<'.$m1[2][0].implode(" ",$t).$m1[5][0].'>';
		}
		else
			$r[]=str_replace(array('<','>'),array('&lt;','&gt;'),$m1[0][0]);
	}
	$r[]=substr($str,$offs);
	while(($tag=array_shift($tags))) // 閉じわすれタグを閉じる
		$r[]="</$tag>";
	return implode("",$r);
}

echo safehtml(<<<EOT
<a href='www.google.com'
target=_blank>link</a> <blink dummy='<'>and</blink><br> <strong onClick='alert("NG")'>cli
ck<br/>me!</strong> <z foo='<script>alert("Boo")</script>'>
EOT
);
?>

var input = "<a title=\"(>_<;)\" href='www.google.com' name='hoge'\n\
>link</a> <blink>and</blink>\n <strong onClick='alert(\"NG\")'>click<br>me!</strong>";

function deleteAttr(attr) {
  return attr.replace(/\s+(\w+)\s*=\s*(["'])((?:[\r\n]|.)*?)\2/g,
    function(all, name, q, value) {
      return name.match(/name|href/i) ? all : '';
    });
}
function escapeHtml(h) {
  return h.replace(/&/g, '&amp;').replace(/</g, '&lt;').replace(/\r?\n/g, '<br/>');
}
function escapeTag(all, fslash, tag, attrs, q, rslash) {
  switch(tag.toUpperCase()) {
    case 'STRONG' :  // drop through
    case 'BR' : attrs = ''; rslash = '/'; break;
    case 'A' : attrs = deleteAttr(attrs); break;
    default : return escapeHtml(all);
  }
  return '<' + fslash + tag + attrs + rslash + '>';
}
function filter(html) {
  var reg = /<(\/?)(\w+)((?:\s+\w+\s*=\s*(["'])(?:[\r\n]|.)*?\4)*)?(\/?)>/gmi;
  var output = [], m, i=0;
  while(m = reg.exec(html)) {
    output.push(escapeHtml(html.substring(i, m.index)));
    output.push(escapeTag.apply(null, m));
    i= m.index + m[0].length;
  }
  output.push(escapeHtml(html.substring(i, html.length)));
  return output.join('');
}
document.body.innerHTML=filter(input);

from HTMLParser2 import HTMLParser2

class HTMLParser3(HTMLParser2):

  def replace(self, s):
    return s.replace('&', '&amp;').replace('<', '&lt;').replace('>', '&gt;').replace('\n', '<br/>')

  def handle_starttag(self, tag, attrs):
    if tag == 'br':
      self.buf += '<br/>'
    else:
      HTMLParser2.handle_starttag(self, tag, attrs)

  def handle_data(self, data):
    self.buf += data.replace('\n', '<br/>')
  
def f(s):
  h = HTMLParser3()
  h.feed(s)
  print s
  print h.buf

if __name__ == '__main__':
  f('''<script foo="<script>alert('bar')</script>">alert('foo')</script>''')
  f('''<script foo="<a href='link'>link</a>">alert('foo')</script>''')
  f('''<a href='www.g>oogle.com'>link</a>''')
  f('''<br>abc\ndef\n<br>''')

# wget http://ja.doukaku.org/comment/2763/download/ -O MyHTMLParser.py
 

from MyHTMLParser import MyHTMLParser, TEXT,TAG


class MyHTMLParser2(MyHTMLParser):

    def filter(self, (state,tag,attrs,text)):
        #  find_filter = lambda x:x.get((state,tag.lower()), lambda x:x)
        def find_filter(filters):
            tag_ = tag.lower()
            if filters.has_key((state,tag_)):
                return filters.get((state,tag_))
            return filters.get((state,None), lambda x:x)


        tag,attrs = find_filter(self.tag_filters)((tag,attrs))
        attrs = find_filter(self.attr_filters)(attrs)
        text = find_filter(self.text_filters)(text)

        return state,tag,attrs,text


def test(html):
    import re

    def allow_attrs(*names):
        return lambda attrs: [(k,quote(v)) for k,v in attrs if k.lower() in names]

    def remove_all_attrs(attrs):
        return []

    def fix_br_tag((tag,attrs)):
        return ('br/',attrs)

    def nl_to_br_in_text(text):
        return re.sub(text, r"(\r\n|\r|\n)","<br />")

    p = MyHTMLParser2()
    p.allow_tags += ['a', 'br', 'strong']
    p.attr_filters[(TAG,'a')] = allow_attrs('href', 'name') 
    p.attr_filters[(TAG,'br')] = remove_all_attrs
    p.attr_filters[(TAG,'strong')] = remove_all_attrs
    p.tag_filters[(TAG,'br')] = fix_br_tag
    p.text_filters[(TEXT,None)] = nl_to_br_in_text
    p.parse(html)

function doukaku57(s){
  var xOK = /<(\/?(?:(a)|br|strong)\b\s?)((?:".*?"|'.*?'|[^>])*?)(?=\/?>)/gi,
      xNH = /\b(?:name|href)\s*=\s*(?:".*?"|'.*?'|[^\s>]*)/gi,
      xBR = /\r\n|[\r\n]|<br\s*>/gi;
  return s.replace(/&/g,'&amp;').replace(/</g,'&lt;').replace(xOK, function(_, tag, A, ats){
    return ('<'+ tag + (A ? (ats.match(xNH) || []).join(' ') : '')).replace(xBR, ' ');
  }).replace(xBR, '<br/>');
}

import java.util.regex._
class ExtendedString(self:String) {
  def gsub(reg:Pattern, f:(Matcher)=>String):String = {
    val result = new StringBuffer
    val m = reg.matcher(self)
    while(m.find) m.appendReplacement(result, f(m))
    m.appendTail(result)
    result.toString
  }
  def gsub(reg:String, f:(Matcher)=>String):String = gsub(Pattern.compile(reg), f)
}
implicit def string2ext(self:String) = new ExtendedString(self);

object htmlEscape{
  lazy val tagRegex = Pattern.compile(
    """(<\s*/?\s*)([^"'<\s>]*\s*)([^"'<>]*(?:"[^"]*"[^"'<>]*|'[^']*'[^"'<>]*)*)((?:>|(?=<)|$(?!\n)))"""
  )
  lazy val attrRegex = Pattern.compile(
    """[\s'"](\w+)\s*=\s*([^\s'">]+|'[^']+'|\"[^"]+")"""
  , Pattern.DOTALL | Pattern.CASE_INSENSITIVE)

  lazy val tagAllowed  = Set("a", "br", "strong")
  lazy val attrAllowed = Map("a" -> Set("href", "name"))

  def replace(s:String, rs:Pair[String,String]*) = {
    rs.foldLeft(s){(r,v)=> r.replace(v._1, v._2)}
  }
  def apply(html:String) = {
    val other = tagRegex.split(html)
    val sb    = new StringBuilder
    val m     = tagRegex.matcher(html)
    var i = -1;while({
      i=i+1;
      try{
        sb.append(replace(other(i), ("<","&lt;"), (">","&gt;"), ("\n","<br/>")));
      }catch{case _=> ()};
      m.find}
    ) {
      val tag = replace(m.group(2).toLowerCase, ("/","")).trim
      sb.append(
        (if(tagAllowed.contains(tag)){
          val attrs = m.group(3).gsub(attrRegex, (m2:Matcher) => {
            if(attrAllowed.getOrElse(tag, Set[String]()).contains(m2.group(1).toLowerCase)) {
              m2.group(0)
            }else {
              ""
            }
          })
          if(tag == "br") List("<br/>")
          else List(m.group(1),m.group(2), attrs, m.group(4))
        }else {
          List(replace(m.group(1), ("<", "&lt;")), m.group(2), 
               replace(m.group(3), ("<", "&lt;"), (">", "&gt;")), m.group(4))
        }).mkString("")
      )
    }
    sb.toString
  }
}

| string accepts in out upToAnyOf letters separators replaceCRs |
string := '<a title="(>_<;)" href=''www.google.com'' 
name=''hoge'' target=_blank>link</a> <blink>a
nd</blink> <strong onClick=''alert("NG")''>click<br>me!</strong>'.

accepts := {#a->#(name href). #strong->#(). #br->#()} as: Dictionary.
string := string copyReplaceAll: '<br>' with: '<br/>'.
in := string readStream.
out := String new writeStream.
upToAnyOf := [:arr | String streamContents: [:ss |
    arr := arr copyWith: nil.
    [arr includes: in peek] whileFalse: [ss nextPut: in next]]].
letters := Character alphabet asArray, Character alphabet asUppercase.
separators := Character separators, #($/ $>).
replaceCRs := [:str | str copyReplaceAll: String cr with: '<br/>'].

[out nextPutAll: (replaceCRs value: (in upTo: $<) escapeEntities). in atEnd] whileFalse: [
    | tag lt isClose isAccepted blank rest |
    (isClose := in peek == $/) ifTrue: [in next].
    tag := upToAnyOf value: separators.
    lt := '<', (isClose ifTrue: ['/'] ifFalse: ['']).
    (isAccepted := accepts keys includes: tag asLowercase) ifFalse: [lt := lt escapeEntities].
    out nextPutAll: lt, tag.
    [blank := upToAnyOf value: letters, '>'. {nil. $>} includes: in peek] whileFalse: [
        | attr equal value quote |
        attr := upToAnyOf value: #($= $>).
        equal := in peek == $= ifTrue: [in next asString] ifFalse: [''].
        value := (#($' $") includes: (quote := in peek))
            ifTrue: [quote asString, (in next; upTo: quote), quote asString]
            ifFalse: [upToAnyOf value: #($  $>)].
        out nextPutAll: (isAccepted
            ifFalse: [blank, attr, equal, value escapeEntities]
            ifTrue: [((accepts at: tag) includes: attr)
                ifTrue: [blank, attr, equal, value] ifFalse: ['']])].
    rest := blank, (in peek == $> ifTrue: [in next asString] ifFalse: ['']).
    out nextPutAll: (isAccepted ifTrue: [rest] ifFalse: [rest escapeEntities])].
World findATranscript: nil.
Transcript cr; show: out contents

"=> <a href='www.google.com' 
name='hoge'>link</a> &lt;blink&gt;a<br/>nd&lt;/blink&gt; <strong>click<br/>me!</strong> "

(use-package :net.html.parser)
(use-package :cl-ppcre)
(use-package :url-rewrite)

(defun html-filter-2 (str)
  (regex-replace-all-lis 
   '(("】" . "&gt;") ("【" . "&lt;") ("\\n" . "<br />"))
   (html-filter-1 
    (prop-filter-2 (pickup-tag (<>-to-escape (prop-filter-1 str)))))))

(defun regex-replace-all-lis (repl-alist str 
			      &optional &key case-insensitive-mode)
  (reduce
   (lambda (res item)
     (let ((scan (create-scanner 
		  (car item)
		  :case-insensitive-mode case-insensitive-mode)))
       (regex-replace-all scan res (cdr item))))
   repl-alist :initial-value str))

(defun <>-to-escape (str)
  (regex-replace-all-lis '((">" . "】")("<" . "【")) str))

(defun <>-to-ltgt (str)
  (regex-replace-all-lis '((">" . "&gt;")("<" . "&lt;")) str))

(defun pickup-tag (str)
  (regex-replace-all-lis 
   '(("【(a\\s*[^\\s】]*)】" .  "<\\1>")
     ("【(/a\\s*)】" .  "</a>")
     ("【(strong\\s*[^\\s】]*)】" .  "<\\1>")
     ("【(/strong\\s*)】" .  "</strong>")
     ("【(br\\s*[^\\s】]*)】" .  "<br />"))
   str))

(defun prop-filter-1 (str)
  (prop-filter-* str "('[^']*')" #'url-encode))

(defun prop-filter-2 (str)
  (prop-filter-* str "(【[^】]*】)" #'<>-to-ltgt))

(defun prop-filter-* (str scan-pat repl-func)
  (let ((scan (create-scanner scan-pat :case-insensitive-mode t)))
    (regex-replace-all scan str 
		       (lambda (match &rest rest)
			 (declare (ignore rest))
			 (if (scan "[<>]" match)
			     (funcall repl-func match)
			     match))
		       :simple-calls t)))

(defun html-filter-1 (string)
  (let ((form (sanitize-html (parse-html string))))
    (apply #'concatenate 'string (build-html form))))

(defun sanitize-html (form)
  (mapcar 
   (lambda (item)
     (if (atom item)
	 item
	 (let ((keys `(,(car item) ,(and (consp (car item)) (caar item)))))
	   (cond ((member :a keys) 
		  `(,(car item) ,@(sanitize-html (cdr item))))
		 ((member :strong keys)
		  `(:strong ,@(sanitize-html (cdr item))))
		 ((member :br keys) :br)
		 ('T "")))))
   form))

(defun build-html (form)
  (if (atom form) 
      form
      (cond ((and (atom (car form)) (eq :br (car form)))
	     `(,(br) ,@(build-html (cdr form))))
	    ((consp (car form))
	     `(,(let* ((top (car form))
		       (keys `(,(car top) ,(and (consp (car top)) (caar top)))))
		      (cond ((member :a keys) (build-a top))
			    ((member :strong keys) (build-strong top))
			    ('T top)))
		,@(build-html (cdr form))))
	    ('T `(,(build-html (car form))
		   ,@(build-html (cdr form)))))))

(defun br () "<br />")

(defun build-strong (form)
  (format nil "<strong>~{~A~}</strong>" (build-html (cdr form))))

(defun build-a (form)
  (let ((tag (car form))
	(body (build-html (cdr form))))
    (if (and (consp (car form)) 
	     (member (second tag) '(:href :name)))
	(format nil "<a ~(~A~)='~A'>~{~A~}</a>" 
		(second tag) 
		(put-dotslash (third tag)) body)
	(format nil "<a>~{~A~}</a>" (build-html (cdr form))))))

(defun put-dotslash (str)
  (let ((s (create-scanner "^([Hh][Tt][Tt][Pp][Ss]*://|^/|\./)")))
    (if (scan s str)
	str
	(concatenate 'string "./" str))))

(defun prop-maker (lst)
  (do ((l lst (cddr l))
       result)
      ((endp l) (nreverse result))
  (push (format nil "~A=\"~A\"" 
		(car l) (<>-to-ltgt (cadr l))) result)))

let filter_attributes tagname attrlist =
  List.filter
    (fun (attrname, _) -> is_allowed_attribute tagname attrname)
    attrlist

let filter_input src = function
  | String _ as x -> x
  | SingleTag (tagname, attrs, p, q) ->
      if is_allowed_tag tagname then
        SingleTag(tagname, filter_attributes tagname attrs, p, q)
      else
        String (String.sub src p (q-p))
  | OpenTag (tagname, attrs, p, q) ->
      if tagname === "br" then
        SingleTag(tagname, [], p, q)
      else if is_allowed_tag tagname then
        OpenTag(tagname, filter_attributes tagname attrs, p, q)
      else
        String (String.sub src p (q-p))
  | CloseTag (tagname, p, q) as x ->
      if is_allowed_tag tagname then x else
        String (String.sub src p (q-p))
  | Eof -> Eof

let sanitizing_output buf string p q =
  for x = p to q-1 do
    match string.[x] with
      | '<' -> Buffer.add_string buf "&lt;"
      | '>' -> Buffer.add_string buf "&gt;"
      | '&' -> Buffer.add_string buf "&amp;"
      | '\n' -> Buffer.add_string buf "<br/>"
      | c -> Buffer.add_char buf c
  done

let output_attribute buf (attrname, value) =
  let quote = if String.contains value '"' then '\'' else '"' in
    Printf.bprintf buf " %s=%c%s%c" attrname quote value quote

let output_tag buf name attrs is_single =
  Printf.bprintf buf "<%s" name;
  List.iter (output_attribute buf) attrs;
  if is_single then Buffer.add_char buf '/';
  Buffer.add_char buf '>'

let output_text_fragment buf = function
  | String s ->
      sanitizing_output buf s 0 (String.length s)
  | SingleTag (s, attrs, _, _) ->
      output_tag buf s attrs true
  | OpenTag (s, attrs, _, _) ->
      output_tag buf s attrs false
  | CloseTag (s, _, _) ->
      Printf.bprintf buf "</%s>" s
  | Eof -> ()

let filter_text text =
  let list = parse_input text in
  let flist = List.map (filter_input text) list in
  let buf = Buffer.create (String.length text) in
    List.iter (output_text_fragment buf) flist;
    Buffer.contents buf
}

import java.util.regex.*;

public class Sample {
    private static final Pattern TAG_FILTER = Pattern.compile
        ("<(¥¥w+)((¥¥s+¥¥w+(¥¥s*=¥¥s*(¥"[^¥"]*¥"|'[^']*'|[¥¥w-:]*))?)*)¥¥s*/?¥¥s*>");
    private static final Pattern END_TAG_FILTER = Pattern.compile
        ("(?i)</(A|STRONG)¥¥s*>");
    private static final Pattern ATTR_FILTER = Pattern.compile
        ("(¥¥w+)¥¥s*=¥¥s*(¥"[^¥"]*¥"|'[^']*'|[¥¥w-:]*)");
    public static String sanitizing(String fragment) {
        fragment = fragment.replaceAll("[¥¥p{Cntrl}&&[^¥¥s]]", "");
        Matcher m = TAG_FILTER.matcher(fragment);
        StringBuffer sb = new StringBuffer();
        while (m.find()) {
            if ("A".equalsIgnoreCase(m.group(1))) {
                String href = null, name = null;
                Matcher m2 = ATTR_FILTER.matcher(m.group(2));
                while (m2.find()) {
                    if ("href".equalsIgnoreCase(m2.group(1))) {
                        href = m2.group(2);
                    } else if ("name".equalsIgnoreCase(m2.group(1))) {
                        name = m2.group(2);
                    }
                }
                String tag = "¥001"+m.group(1) + ((href !